我正在嘗試改進我之前執行緒中的作業簿宏。我需要執行以下操作：
- 將搜索限制在作業表的范圍內（例如作業表 1 B1:N:200）
- 在限制范圍Sheet1的第8列（I）中搜索關鍵字（“商品”）
- 復制在找到實體（“商品”）的同一行的第 9 列 (J) 中找到的資料
- 將作業表 1 - 第 9 列的值粘貼到作業表 2 -第 7 列
- 再次搜索關鍵字（“服務”）的限制范圍Sheet1的第8列（I）
- 復制在找到實體（“服務”）的同一行的第 9 列 (J) 中找到的資料
- 將作業表 1 - 第 9 列的值粘貼到作業表 2 -第 8 列
我正在嘗試自學以了解代碼的作業原理并將其與上一個執行緒中@CDP1802 提供的代碼集成，但我無法獲得如何拆分商品和服務匹配的結果位置。
這是@CDP1802 在我之前的執行緒中提供的作業代碼。
Option Explicit
Sub CopyCells()
Const ROW_START = 3
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
Dim keywords, word, t0 As Single: t0 = Timer
keywords = Array("Goods", "Services")
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lastrow2 = ROW_START
Application.ScreenUpdating = False
With ws1
lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
For Each word In keywords
For r = 1 To lastrow1
If Len(.Cells(r, "I")) = 0 Then
Exit For
ElseIf .Cells(r, "I") = word Then
'Sht1 col 2 to Sht2 Col 3 (no format values only)
'Sht1 col 5 to Sht2 Col 4 (with format and values)
ws2.Cells(lastrow2, "C") = .Cells(r, "B")
ws2.Cells(lastrow2, "D") = .Cells(r, "E")
.Cells(r, "E").Copy
ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
lastrow2 = lastrow2 1
n = n 1
End If
Next
Next
End With
Application.ScreenUpdating = True
MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
這是我嘗試做我需要做的代碼，但是我不知道如何使用前一個位置計數器的值作為“服務”的下一個引數，以便在貨物結果完成后跟隨下一行。當前代碼再次啟動服務結果到位置 1。
總之，我正在尋找將所需結果集成到 1 個宏中以提高效率的代碼。
Sub test1code()
Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long
Dim resultrow As Long
Const ROW_START = 4
'for Goods data
With Worksheets(1)
resultrow = 1
lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
For counterSht1 = 1 To lngLastRowSht1 1
If Len(Sheets(1).Range("H" & (counterSht1))) = 0 Then
Exit For
ElseIf Sheets(1).Range("H" & (counterSht1)) = "Goods" Then
Sheets(2).Range("F" & (resultrow)).Value = Sheets(1).Range("I" & counterSht1).Value
resultrow = resultrow 1
End If
Next counterSht1
End With
'for Services data
With Worksheets(1)
resultrow = 1
lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
For counterSht1 = 1 To lngLastRowSht1 1
If Len(Sheets(1).Range("H" & (counterSht1))) = 0 Then
Exit For
ElseIf Sheets(1).Range("H" & (counterSht1)) = "Services" Then
Sheets(2).Range("G" & (resultrow)).Value = Sheets(1).Range("I" & counterSht1).Value
resultrow = resultrow 1
End If
Next counterSht1
End With
End Sub
uj5u.com熱心網友回復：
洗掉resultrow = 1服務代碼塊，以便在回圈“商品”后保留前一行編號。
假設上述解決這個問題，以下是你可以這兩個程序合并成一個單一的塊（也被洗掉lngLastRowSht2，因為它是沒有被使用，規范使用Worksheets和Sheets）：
Sub test1code()
Dim lngLastRowSht1 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long
Dim resultrow As Long
Const ROW_START = 4
With Worksheets(1)
resultrow = 1
lngLastRowSht1 = .Cells(.Rows.Count, 4).End(xlUp).Row
'for Goods data
For counterSht1 = 1 To lngLastRowSht1 1
If Len(Worksheets(1).Range("H" & counterSht1)) = 0 Then
Exit For
ElseIf Worksheets(1).Range("H" & counterSht1) = "Goods" Then
Worksheets(2).Range("F" & resultrow).Value = Worksheets(1).Range("I" & counterSht1).Value
resultrow = resultrow 1
End If
Next counterSht1
'for Services data
For counterSht1 = 1 To lngLastRowSht1 1
If Len(Worksheets(1).Range("H" & counterSht1)) = 0 Then
Exit For
ElseIf Worksheets(1).Range("H" & counterSht1) = "Services" Then
Worksheets(2).Range("G" & resultrow).Value = Worksheets(1).Range("I" & counterSht1).Value
resultrow = resultrow 1
End If
Next counterSht1
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/363802.html