带你入门VBA系列之：不懂的代码快点贴过来

shewoyu

谢谢41楼，不会了。

能否帮我看一下27楼的问题！

ldy888

数组问题:搜索了很多帖子,没搞明白它们的区别,请版主解答 QEE用兄已答了,有点明白了,谢谢!!

下面是模仿单格A1到C3

A B C
1 甲 乙 丙
2 乙 一 忆
3 丙 并 兵

arr1 = Range("a1:c1")这个该叫什么数组?
arr2 = Range("a1:a3")这个该叫什么数组?
arr3 = Array(甲, 乙, 丙)这应该是1行的1维数组吧?

arr4 = Range("a1:c3") 这应该是3行3列的2维数组吧?

arr1,arr2,arr4 用arr3的方式分别该如何写? 要用";"分号吗?

arr1=Array(?)

arr2=Array(?)

arr4=Array(?)

下面这段代码,只有arr3能通过,换其它的不行,arr4是多维数组,用什么样方式套进代码中实现查找?

i= "甲"

If UBound(Filter(arr3, i, False)) = UBound(arr3) Then MsgBox "不存在"

一下问了这么多,[em04]还请各位老师解惑.

[此贴子已经被作者于2006-6-10 17:52:45编辑过]

qee用

43楼:
arr = Range("...")得到的数组都是2维数组,第一维是行,第二维是列.
Array函数只能得到1维数组.
Filter函数只能对1维数组进行.

ldy888

接43楼问题,如何在arr4中导出第一行第一列成立一个新的一维数组?

arr5 = arr4(?) 请问该如何写

ricky.wen

还是上传一个附件另外发贴提问吧.我在一楼说的很清楚.本贴是学习.一是不要贴海量代码.二是不要发解决问题的贴.如果有问题有单独发贴提问

兰老师:

你好!本人由于工作的需要自学了VBA,就是没有明师指导,代码写得太长,功能却是非常简单!你可以帮我优化一下吗？代码是功能是自动将“6wk Plan-wk23 version 0.exe”表里面的生产计划更新到“生产计划跟踪表.exe”表中。谢谢！！！
Sub Update()
file1 = "生产计划跟踪表.xls"
file1sheet1 = "Build Plan Summary"
file1sheet2 = "Actually Build Qty"
file2 = Cells(2, 3).Value + ".xls"
file2sheet1 = Cells(3, 3).Value
startdivide1 = "ISO NO."
enddivide1 = "Subtotal"
startdivide2 = Cells(4, 3).Value
ActiveSheet.Unprotect Password:="hdd"
Dim fristdayofweek As Date
Wek1 = Weekday(Date, vbMonday)
fristdayofweek = Date - Wek1 - 1
Week = Date
Week = Format(Week, "ww")
Cells(2, 7).Value = "WK" & Week
Cells(4, 7).Value = fristdayofweek
Application.DisplayAlerts = False
Application.ScreenUpdating = False
startrow1 = 4
Do Until Cells(startrow1, 3).Value = startdivide1
startrow1 = startrow1 + 1
If startrow1 > 1000 Then
MsgBox "找不到file1的行起始点:" & startdivide1 & "!请找原因！"
Stop
Else
End If
Loop
endrow1 = startrow1 + 1
Do Until Cells(endrow1, 2).Value = enddivide1
endrow1 = endrow1 + 1
If endrow1 > 1000 Then
MsgBox "找不到file1的行终止点:" & enddivide1 & "!请找原因！"
Stop
Else
End If
Loop
startcol1 = 6
Do Until Cells(4, startcol1).Value = fristdayofweek
startcol1 = startcol1 + 1
If startcol1 > 1000 Then
MsgBox "找不到file1的列起始点:" & fristdayofweek & "!请找原因！"
Stop
Else
End If
Loop
ThisWorksheetName = ActiveSheet.Name
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1), Cells(endrow1 - 1, startcol1)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 2), Cells(endrow1 - 1, startcol1 + 2)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 4), Cells(endrow1 - 1, startcol1 + 4)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 6), Cells(endrow1 - 1, startcol1 + 6)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 8), Cells(endrow1 - 1, startcol1 + 8)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 10), Cells(endrow1 - 1, startcol1 + 10)).ClearContents
Worksheets(ThisWorksheetName).Range(Cells(startrow1 + 1, startcol1 + 12), Cells(endrow1 - 1, startcol1 + 12)).ClearContents
On Error Resume Next
fName = Workbooks(file2).Name
If Err.Number = 9 Then
Else
Windows(file2).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End If

Application.Workbooks.Open ThisWorkbook.Path & "\" & file2
Sheets(file2sheet1).Select

startrow2 = 25
Do Until Cells(startrow2, 1).Value = startdivide2
startrow2 = startrow2 + 1
If startrow2 > 1000 Then
MsgBox "找不到file2的行起始点:" & startdivide2 & "!请找原因！"
Stop
Else
End If
Loop
startcol2 = 6
Do Until Cells(8, startcol2).Value = fristdayofweek
startcol2 = startcol2 + 1
If startcol2 > 1000 Then
MsgBox "找不到file2的列起始点:" & fristdayofweek & "!请找原因！"
Stop
Else
End If
Loop
For i = 1 To endrow1 - startrow1 - 1
Windows(file2).Activate
checksn = Cells(startrow2 + i, 3).Value
Windows(file1).Activate
If Cells(startrow1 + i, 3).Value = checksn Then
For j = 1 To 7
Windows(file2).Activate
copydata = Cells(startrow2 + i, startcol2 + (j - 1)).Value
Windows(file1).Activate
Cells(startrow1 + i, startcol1 + (j - 1) * 2).Value = copydata
Next j
Else
For i1 = 1 To endrow1 - startrow1 - 1
Windows(file2).Activate
If Cells(startrow1 + i1, 3).Value = checksn Then
For j = 1 To 7
Windows(file2).Activate
copydata = Cells(startrow2 + i1, startcol2 + (j - 1)).Value
Windows(file1).Activate
Cells(startrow1 + i, startcol1 + (j - 1) * 2).Value = copydata
Next j
Exit For
Else
End If
Next i1
End If
Next i
For j = 1 To 7
Windows(file2).Activate
checksumdata = Cells(startrow2 + (endrow1 - startrow1), startcol2 + (j - 1)).Value
Windows(file1).Activate
If Cells(endrow1, startcol1 + (j - 1) * 2) = checksumdata Then
Else
MsgBox "日期：" & Cells(4, startcol1 + (j - 1) * 2).Value & "报表总数与计划报表的总数不一致！请查明原因！"
End If
Next j
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Windows(file2).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(file1).Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="hdd"
Sheets(file1sheet2).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="hdd"
Sheets(file1sheet1).Select
ActiveWorkbook.Save
End Sub

[此贴子已经被兰色幻想于2006-6-11 12:12:19编辑过]

qee用

45楼:参考
http://club.excelhome.net/viewthread.php?tid=127324

ldy888

TO qee用

精华帖早就收藏研读过了

arr5 = Application.Index(arr4, , 1)

可arr5还是一个2维数组,套不进这个代码

i= "甲"

If UBound(Filter(arr5, i, False)) = UBound(arr5) Then MsgBox "不存在"

多谢 用兄精彩解答 [em23][em23][em23]

[此贴子已经被作者于2006-6-11 0:22:50编辑过]

qee用

就49楼的问题而论:
如果取的是一行,VBA可以宽容地认为是一维数组,如果取的是一列,可以在进行一次转换.
另外,arr = Range("...")取得的数组下标是从1开始,Filte得到的下标是从0开始,它们都不受option base的限制,所以应当这样:
Sub atest()
Dim arr4, arr5, arr6, i
arr4 = Sheet1.Range("A1:C3")
arr5 = Application.Index(arr4, , 1)
arr6 = Application.Transpose(arr5)
i = "甲"
If UBound(Filter(arr6, i, False)) = UBound(arr5) - 1 Then
MsgBox "不存在"
Else
MsgBox "存在"
End If
End Sub

爱歌学习

以下是引用[I]yuhongpu[/I]在2006-6-9 8:23:59的发言：[BR]什么时候用绝对引用,什么时候用相对引用(公式里)?

把公式复制到别处时，如果希望公式中的行列号不要随着复制方向自动变化，就用绝对地址，否则，用相对地址。

zbs112

从ACCESS筛选不同的地域名称，以下的代码是如何理解？

Dim cText$, j%
cText = ","
For i = 1 To RST.RecordCount
If InStr(cText, "," & RST.Fields("地域") & ",") = 0 Then
j = j + 1
cText = cText & RST.Fields("地域") & ","
With ListView1.ListItems.Add(, , j)
.SubItems(1) = IIf(IsNull(RST.Fields("地域")), "", RST.Fields("地域"))
End With
End If
RST.MoveNext
Next i

以下2句是如何理解的？ InStr(cText, "," & RST.Fields("地域") & ",") = 0 ‘这是查找有无重复值 cText = cText & RST.Fields("地域") & ","勤 ’把记录逐步连成一个用“,”分隔的字符串

[此贴子已经被兰色幻想于2006-6-11 11:14:01编辑过]