excel - VBA Excel-根据用户输入将单元格值和相关行放入另一个工作表中
问题描述
全部-
我对 VBA 很陌生,我真的需要帮助。我有一个名为 Sheet 1 的工作表,看起来像这样(这是从中复制数据的地方)
和另一个看起来像这样的工作表(Sheet2)(这是数据将被复制到的位置)。注意顺序和上面的不一样
当用户在诸如“巴黎”之类的地方键入时,我希望它复制所有与“巴黎”对应的值,并且它是关联的行。所以最终结果应该是这样的
这是我到目前为止的代码。现在我可以根据用户输入提取所有相应的值,但我无法终生弄清楚如何获取关联的行。请帮忙!任何输入将不胜感激。
Dim x As String
Dim K As Long
Dim ct As Variant
Dim r As Range
Dim w1 As Worksheet
Dim w2 As Worksheet
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
x = Application.InputBox("Please Enter Place")
w1.Activate
K = 3
For Each r In Intersect(Range("C3:C3" & a), ActiveSheet.UsedRange)
ct = r.Value
If InStr(ct, x) > 0 And ct <> "" Then
r.Copy w2.Cells(K, 1)
K = K + 1
w2.Activate
End If
Next r
End Sub
解决方案
将整个范围分配给数组以便更快地循环,然后一旦数组找到与您的输入字符串匹配的值,将值重写到您的第二张表。
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet, wsArr()
set ws1 = thisworkbook.worksheets("Sheet1")
set ws2 = thisworkbook.worksheets("Sheet2")
With ws1
wsArr = .Range(.Cells(3, 1), .Cells(LastRow(ws1), 4)).Value
End With
Dim findStr As String
findStr = InputBox("Please Enter Place")
Dim i As Long, r as long
Application.ScreenUpdating = False
With ws2
.Range("A3:D3").Value = array("Place", "Name", "Thing", "Animal")
For i = LBound(wsArr) To UBound(wsArr)
If wsArr(i, 3) = findStr Then
r = LastRow(ws2) + 1
.Cells(r, 1) = wsArr(i, 3)
.Cells(r, 2) = wsArr(i, 1)
.Cells(r, 3) = wsArr(i, 2)
.Cells(r, 4) = wsArr(i, 4)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Function LastRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1) As Long
With ws
LastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
End Function
为了获得更好的性能,请考虑执行 aCOUNTIF()
来获取范围内出现次数的计数findStr
- 这样您就可以将此值用于ReDim
新数组以便将匹配项写入其中,然后一次将数组写入Sheet2
所有内容。
推荐阅读
- c# - 根据实现的接口将 NonAction 应用于控制器方法
- javascript - 搜索栏功能
- python - 使用 keras 创建最后一个输出作为当前输入 LSTM 模型
- python - Python argparse 将参数存储为列表而不是整数。令人困惑还是正确?
- modelica - 避免在 Dymola 中与 .mos 文件一起生成临时文件
- html - React 图片制作 src url 问题
- r - 根据 dplyr 中的另一列替换列中的 vaue
- android - 使用 ionic cordova 构建的 keystore.jks 签名 APK 的问题
- encryption - ECDH 密钥可以从 ECDSA 密钥派生吗?
- python - 字典复制自身的问题