我是VBA的新手，目前正忙着维护与数据库连接的Excel中的项目列表。
sheet1列（从B列开始）
UID |编号。 | itemweight |加工
sheet2相同的标题（从A列开始）
UID |编号。 | itemweight |删除
我构思了这个理论目标并对其进行了编码，尝试了几次。
它没有循环:(并没有实现我的目标。
任何建议都会有所帮助！提前致谢
以下是我的步骤：
Private Sub CommandButton3_Click()
' Loop until no new UID found
' 1. GoTo Sheet2 to First/Next Cell with UID
' 2. Read UID value
' 3. GoTo Sheet1
' 4. Search in UID column for read UID
' 5. if UID found
' 5.1 get data from Sheet1
' 5.2 GoTo Sheet 2
' 5.3 Past data in right cells
' 5.4 GoTo Sheet 1
' 5.5 Put check flag in proccessed field
' 6. if UID NOT found
' 6.1 GoTo Sheet 2
' 6.2 Put delete flag in delete field
' Loop End
'
' GoTo Sheet1
' Search for all parts with no checked process flag
' Copy datasets
' GoTo Sheet2
' Add data to the end of table
---------------------------------------------------
Dim dict As Object
Dim proc As Range
Dim del As Range
Dim chk, myrange As Range
Set dict = CreateObject("Scripting.dictionary")
Dim sheet1 As Worksheet, Sheet2 As Worksheet
Set sheet1 = ThisWorkbook.Worksheets("MetadataSheet")
Set Sheet2 = ThisWorkbook.Worksheets("PlanningData")
' Read values from sheet2 to dictionary
Dim lastRow As Long
lastRow = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
' Store value to dictionary
dict(Sheet2.Cells(i, 1).Value) = 1
Next
' Read from sheet1 and check if each value exists
lastRow = sheet1.Cells(sheet1.Rows.Count, 2).End(xlUp).Row
For i = 1 To lastRow
' Check if value exists in dictionary
If dict.exists(sheet1.Cells(i, 2).Value) Then
' found
sheet1.Range("B2:D2").Select
Selection.Copy
Sheet2.Select
Sheet2.Range("A2:C2").Select
ActiveSheet.Paste
sheet1.Select
sheet1.Range("E2").Select
Set proc = sheet1.Range("E2")
proc.Value = "X"
Else
' not found
Sheet2.Select
Set del = Sheet2.Range("D2")
del.Value = "X"
End If
Next
'for initial load
sheet1.Select
Set chk = sheet1.Range("E2", "E" & lastRow)
For Each chk In myrange
If chk.Value = "" Then
chk.Range("B2:D2").Select
Selection.Copy Destination:= _
Sheets(2).Range("A65536").End(xlUp)(2, 1)
End If
Next chk
End Sub
答案 0 :(得分：0)
这段代码几乎运作良好。对于第一次运行，它将数据从sheet1加载到sheet2。 在第二次运行期间，我得到一个类型不匹配错误！
Dim x As Long
Dim y As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1, lastRow2, lastrow3 As Long
Dim proc As Range
Dim del As Range
Set ws1 = Worksheets("Metadatasheet")
Set ws2 = Worksheets("PlanningData")
y = 2 'this is the first row where your data will output
x = 2 'this is the first row where you want to check for data
lastRow1 = ws1.Range("B:B").Find("*", SearchDirection:=xlPrevious).Row
lastRow2 = ws2.Range("A:A").Find("*", SearchDirection:=xlPrevious).Row
If Not IsEmpty(ws2.Range("B2").Value) Then
Do Until ws1.Range("B2") = ""
For x = 2 To lastRow2
If ws1.Range("B2", "B" & lastRow1).Value = ws2.Range("A2", "A" & lastRow2).Value Then
ws2.Range("A" & y).Value = ws1.Range("B" & x).Value
ws2.Range("B" & y).Value = ws1.Range("C" & x).Value
ws2.Range("C" & y).Value = ws1.Range("D" & x).Value
Set proc = ws1.Range("E" & y)
proc.Value = "X"
y = y + 1
Else
Set del = ws2.Range("D" & y)
del.Value = "X"
End If
Next x
Loop
Else
'lastrow3 = ws1.Range("E:E").Find("*", SearchDirection:=xlPrevious).Row
For x = 2 To lastRow1
If Not ws1.Range("E" & y).Value = "X" Then
ws2.Range("A" & y).Value = ws1.Range("B" & x).Value
ws2.Range("B" & y).Value = ws1.Range("C" & x).Value
ws2.Range("C" & y).Value = ws1.Range("D" & x).Value
y = y + 1
End If
Next x
End If
End Sub