好的，我在这里尝试过，但失败了，但我在同一工作簿中有两张表。
片材"；AF"；并且片材"；CurrentList"；。
如果表中的列S"是"；CurrentList"；说"；是"；我想把同一行中的列R附加到"表"中运行列表的底部；AF"；。表AF中可能已经有50000个值，因此它必须附加到列表的最底部。
我开始尝试分解其他一些代码，但它抛出了大量错误，所以不确定这是什么方法：
Sub AddData()
Dim wsDA As Worksheet, wsD As Worksheet, lastRDA As Long, lastRD As Long
Dim arrDA As Variant, rngDel As Range, arrD As Variant, arrCopy As Variant
Dim i As Long, j As Long, k As Long
Set wsDA = Worksheets("CurrentList")
Set wsD = Worksheets("AF")
lastRDA = wsDA.Range("R" & Rows.Count).End(xlUp).Row
lastRD = wsD.Range("A" & Rows.Count).End(xlUp).Row
'I got completely lost at this point..
arrDA = wsDA.Range("R:" & lastRDA).Value
arrD = wsD.Range("A1" & lastRDA).Value
ReDim arrCopy(1 To 2, 1 To UBound(arrDA))
For i = 1 To UBound(arrDA)
If arrDA(i, 10) = "Yes" Then
k = k + 1: arrCopy(1, k) = arrDA(i, 1): arrCopy(2, k) = arrDA(i, 2)
arrCopy(2, k) = arrDA(i, 3)
End
End If
End Sub
VBA查找
提示
- 别忘了工作簿
- 使用描述性变量名称
- 添加一些评论。没有我做的那么多，但评论每一节
代码
Option Explicit
Sub AddData()
' Write values from Source Range to Lookup and Result Arrays.
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
' Define Source Worksheet.
Dim src As Worksheet
Set src = wb.Worksheets("CurrentList")
' Define Source Last Row.
Dim LastRow As Long
LastRow = src.Cells(src.Rows.Count, "S").End(xlUp).Row
' Define Source Lookup Column Range.
Dim rng As Range
Set rng = src.Range("S1").Resize(LastRow)
' Write values from Source Lookup Column Range to Lookup Array.
Dim Lookup As Variant
Lookup = rng.Value
' Define Source Result Column Range.
Set rng = src.Range("R1").Resize(LastRow)
' Write values from Source Result Column Range to Result Array.
Dim Result As Variant
Result = rng.Value
' Status: We have two arrays of the same size. We are going
' look for "Yes" in Lookup Array and write the corresponding
' value in Result Array to Result Array, yes, to the same array.
' We cannot get more matching results, so there will be no overflow.
' We will count the number of matches (MatchCount) to later know
' how many values to write to the Destination Range.
' Write values from Lookup and Result Arrays to Result Array (No typo).
Dim LookupValue As Variant ' Current Lookup Value: the value
' in the current element of Lookup Array
Dim i As Long ' Lookup/Result Array Counter (same size)
Dim MatchCount As Long ' Match Counter
' Iterate rows (values) in Lookup Array.
For i = 1 To UBound(Lookup)
' Write value of current element in Lookup Array to Lookup Value
LookupValue = Lookup(i, 1)
' Check if Lookup Value is not an error value.
If Not IsError(LookupValue) Then
' Check if Lookup Value is equal to the Criteria ("Yes").
If LookupValue = "Yes" Then
' Increase the Match Count.
MatchCount = MatchCount + 1
' Write value of current element in Result Array
' to the position determined by Match Count to itself.
Result(MatchCount, 1) = Result(i, 1)
End If
End If
Next i
' Validate Match Count.
If MatchCount = 0 Then ' No match was found.
Exit Sub
End If
' Write values from Result Array to Destination Range.
' Define Destination Worksheet.
Dim dst As Worksheet
Set dst = wb.Worksheets("AF")
' Define Destination First Cell, the cell after the last non-empty cell.
Set rng = dst.Cells(dst.Rows.Count, "A").End(xlUp).Offset(1)
' Define Destination Range.
' Note that you can resize only an array's last dimension which in our case
' is columns, and not rows. So we resize the resulting
' Destination range only to the size of Match Count, not to
' the size of 'UBound(Result, 1)'.
Set rng = rng.Resize(MatchCount)
' Write values from Result Array to Destination Range.
rng.Value = Result
' Inform user.
MsgBox "Data transferred.", vbInformation, "Success"
End Sub