Private Sub cmdSupplementary_pay_Click()
Dim i, j, n, n1, n2, czint, filla As Integer
Dim ColName(), czColarr(), fkColarr() As String
Dim isA, isB As Booleann = 0
For j = 1 To Sheet1.UsedRange.Columns.Count
n = n + 1
ReDim Preserve ColName(n)
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
ColName(n - 1) = Sheet1.Range(Mid(Sheet1.Cells(1, j).Address, 2, 1) + CStr(1))
Else
ColName(n - 1) = Sheet1.Range(Mid(Sheet1.Cells(1, j).Address, 2, 2) + CStr(1))
End If
NextFor j = 0 To UBound(ColName)
If ColName(j) = "操作" Then
czint = j + 1
End If
If ColName(j) = "付款性质" Then
filla = j + 1
End If
Next
Erase ColNamen1 = 0
n2 = 0
For i = 2 To Sheet1.UsedRange.Rows.Count + 1
If Sheet1.Cells(i, 1) <> "" Then
If (Sheet1.Cells(i, czint) = "财务付款确认") Then
n1 = n1 + 1
ReDim Preserve czColarr(n1)
'要拷贝的指定位置 =BF700
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
czColarr(n1 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 1) + CStr(i)
Else
czColarr(n1 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 2) + CStr(i)
End If
End If
If (Sheet1.Cells(i, filla) <> "") Then
n2 = n2 + 1
ReDim Preserve fkColarr(n2)
'filla + 6 是‘付款性质’字段后面的列值
'=BF695:BL695
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
fkColarr(n2 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 1) + CStr(i) + ":" + Mid(Sheet1.Cells(i, filla + 6).Address, 2, 1) + CStr(i)
Else
fkColarr(n2 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 2) + CStr(i) + ":" + Mid(Sheet1.Cells(i, filla + 6).Address, 2, 2) + CStr(i)
End If
End If
Else
If Not (EmptyArr(fkColarr) And EmptyArr1(czColarr)) Then
If UBound(fkColarr) = UBound(czColarr) Then
For j = 0 To UBound(fkColarr)
If fkColarr(j) <> "" Then
Sheet1.Range(fkColarr(j)).Cut Sheet1.Range(czColarr(UBound(czColarr) - 1 - j))
End If
Next
End If
End If
n1 = 0
n2 = 0
Erase czColarr
Erase fkColarr
End If
Next
End Sub
Function EmptyArr(ByRef x() As String) As Boolean '判断是否为空数组的自定义函数
Dim tempStr As String
tempStr = Join(x, ",")
EmptyArr = LenB(tempStr) <= 0
End Function
-----------------------------------------------
If Not (EmptyArr(fkColarr) And EmptyArr1(czColarr))
这行总是提示“缺少数组或用户定义类型”错误, 如果改成If Not (EmptyArr(fkColarr)) 就没有错误,刚学习VBA 弄了一下午不知道为什么错,请大家告诉我改怎么改Excel VBA
Dim i, j, n, n1, n2, czint, filla As Integer
Dim ColName(), czColarr(), fkColarr() As String
Dim isA, isB As Booleann = 0
For j = 1 To Sheet1.UsedRange.Columns.Count
n = n + 1
ReDim Preserve ColName(n)
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
ColName(n - 1) = Sheet1.Range(Mid(Sheet1.Cells(1, j).Address, 2, 1) + CStr(1))
Else
ColName(n - 1) = Sheet1.Range(Mid(Sheet1.Cells(1, j).Address, 2, 2) + CStr(1))
End If
NextFor j = 0 To UBound(ColName)
If ColName(j) = "操作" Then
czint = j + 1
End If
If ColName(j) = "付款性质" Then
filla = j + 1
End If
Next
Erase ColNamen1 = 0
n2 = 0
For i = 2 To Sheet1.UsedRange.Rows.Count + 1
If Sheet1.Cells(i, 1) <> "" Then
If (Sheet1.Cells(i, czint) = "财务付款确认") Then
n1 = n1 + 1
ReDim Preserve czColarr(n1)
'要拷贝的指定位置 =BF700
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
czColarr(n1 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 1) + CStr(i)
Else
czColarr(n1 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 2) + CStr(i)
End If
End If
If (Sheet1.Cells(i, filla) <> "") Then
n2 = n2 + 1
ReDim Preserve fkColarr(n2)
'filla + 6 是‘付款性质’字段后面的列值
'=BF695:BL695
If Mid(Sheet1.Cells(1, j).Address, 2, 2) = "$" Then
fkColarr(n2 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 1) + CStr(i) + ":" + Mid(Sheet1.Cells(i, filla + 6).Address, 2, 1) + CStr(i)
Else
fkColarr(n2 - 1) = Mid(Sheet1.Cells(i, filla).Address, 2, 2) + CStr(i) + ":" + Mid(Sheet1.Cells(i, filla + 6).Address, 2, 2) + CStr(i)
End If
End If
Else
If Not (EmptyArr(fkColarr) And EmptyArr1(czColarr)) Then
If UBound(fkColarr) = UBound(czColarr) Then
For j = 0 To UBound(fkColarr)
If fkColarr(j) <> "" Then
Sheet1.Range(fkColarr(j)).Cut Sheet1.Range(czColarr(UBound(czColarr) - 1 - j))
End If
Next
End If
End If
n1 = 0
n2 = 0
Erase czColarr
Erase fkColarr
End If
Next
End Sub
Function EmptyArr(ByRef x() As String) As Boolean '判断是否为空数组的自定义函数
Dim tempStr As String
tempStr = Join(x, ",")
EmptyArr = LenB(tempStr) <= 0
End Function
-----------------------------------------------
If Not (EmptyArr(fkColarr) And EmptyArr1(czColarr))
这行总是提示“缺少数组或用户定义类型”错误, 如果改成If Not (EmptyArr(fkColarr)) 就没有错误,刚学习VBA 弄了一下午不知道为什么错,请大家告诉我改怎么改Excel VBA
解决方案 »
- 我需要调用1个VC做的的DLL,能不能把那个DLL整合到VB程序里?(也就是生成后只有1个文件)
- VB把数据库的数据放到WORD或EXCEL的模板里打印
- VB新手提问,在线等:目录和文件问题
- 如何在windows系统刚启动时,就进入程序?
- 如何取消DBGRID和DATA控件的绑定,使DBGRID恢复最初的空白的3行3列?
- 奇怪 Round 函数有问题!!!
- 推荐一个资源下载站点,不需注册
- compile error: can't find project or library
- 谁能告诉我CoolMenu V3.0.24a 的注册码?急用。在线等待!!谢了
- win10能运行VB的什么版本
- 为何在公司PING不通SMTP.163.COM或smtp.qq.com等其它Smtp服务器…
- 10进制转16进制,如何在前面加上&H
http://stackoverflow.com/questions/12386935/byref-argument-type-mismatch
Dim ColName(), czColarr(), fkColarr() As String更改为Dim ColName() As String, czColarr() As String, fkColarr() As String