我希望你們一切都好。
我有一些 VBA 代碼遇到了一些麻煩，想知道是否有人可以伸出援手，好嗎？
問題; 如果作業表 1 上有多行需要復制，我只能復制一行。我不知道如何讓它搜索、匹配然后復制多行。
編輯 我希望實作的是復制列中的值；將M、N 和 O （支付日期、支付金額、票據）放入第 2 頁表格中各自的行，I、J 和 L 列（收到的金額、收到日期和票據）
我的 VBA 技能有點有限啊，所以我在這方面從來沒有走得太遠。
更新了作業表 1 和作業表 2 的螢屏截圖
編輯
uj5u.com熱心網友回復：
將匹配行復制到 Excel 表 (ListObject)
請注意，
D2表格（復制到其余單元格）中的簡單公式可以執行相同的操作：=IFERROR(INDEX(Sheet1!D:D,MATCH([@Invoice NR],Sheet1!$A:$A,0)),"")
Option Explicit
Sub UpdateTable()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
If slRow < 2 Then Exit Sub ' no data in column range
Dim srg As Range: Set srg = sws.Range("A2:A" & slRow) ' to lookup
Dim scrg As Range: Set scrg = srg.EntireRow.Columns("D:G") ' to copy
Dim cCount As Long: cCount = scrg.Columns.Count ' how many columns in 'D:G'?
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table1")
Dim srIndex As Variant
Dim dCell As Range
' Copy.
For Each dCell In dtbl.ListColumns(1).DataBodyRange
srIndex = Application.Match(dCell.Value, srg, 0) ' find a match
If IsNumeric(srIndex) Then ' if match was found then copy if not blank
If Application.CountBlank(scrg.Rows(srIndex)) < cCount Then
dCell.Offset(, 3).Resize(, cCount).Value _
= scrg.Rows(srIndex).Value
End If
End If
Next dCell
' Inform.
MsgBox "Table updated."
End Sub
uj5u.com熱心網友回復：
Sub missingData()
Dim s1 As Worksheet
Dim s2 As Worksheet
Set s1 = ActiveWorkbook.Worksheets("Sheet1")
Set s2 = ActiveWorkbook.Worksheets("Sheet2")
lrow = Cells(Rows.Count, 1).End(xlUp).Row 1
Dim i As Integer
i = 1 //start index
Do While (i < lrow)
For j = 1 To 7
If s1.Cells(i, j) <> "" And s2.Cells(i, j) = "" Then
s2.Cells(i, j) = s1.Cells(i, j)
End If
Next j
i = i 1
Loop
End Sub
我認為它會解決問題，但如果你的檔案有大資料，它可能會花一些時間
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/438576.html
標籤：擅长 vba 办公室365 字符串匹配 excel表格
上一篇：基于給定值的公式幫助SUM