将具有相应 ID 号的行复制到不同的工作表中
Copying row with corresponding ID number into a different worksheet
我有一个可让您输入 ID 号的用户表单,我希望将具有相应 ID 号的行复制到单元格未对齐的不同工作表中。
我试过使用数组作为数据的目的地,但是当我 运行 它没有做任何事情。我知道我可以用丑陋的方式做到这一点,并将每个单元格编码为转到另一个单元格,但我认为对正在复制的数据使用数组会起作用,现在我需要知道如何将所有目标单元格放在一个单元格中变量并将数据复制到那里
Dim ws As Worksheet
Set ws = Sheets("Arkiv")
Dim DN As Worksheet
Set DN = Sheets("DN")
idRow = Sheets("Arkiv").Columns("A:A").Find(what:=IDnum).Row
IDnum = TextBox1.Text
'Dim shipFrom As Range
'Set shipFrom = Sheets("Arkiv").Range("B" & idRow)
Dim goTo1 As Variant
goTo1 = Array(DN.Range("D9"), DN.Range("E9"), DN.Range("I9"), DN.Range("C20"), DN.Range("D20"), DN.Range("E45"), DN.Range("G20"), DN.Range("H20"), DN.Range("I20"))
Dim data As Variant
data = Array(ws.Range("B" & idRow), ws.Range("C" & idRow), ws.Range("D" & idRow), ws.Range("E" & idRow), ws.Range("F" & idRow), ws.Range("G" & idRow), ws.Range("H" & idRow), ws.Range("I" & idRow))
goTo1 = data
我希望变量 "data to be copied over to the cells inside of the "goTo1" 中的数据按照我将它们放入数组的相应顺序排列。enter code here
如果您使用查找方法,请始终指定 LookAt
参数,否则 VBA 使用上次使用的任何内容(用户或 VBA) .
你需要循环遍历地址,一个一个复制。您不能一次复制 non-coninous 个范围。
所以像这样的东西应该有用。
Option Explicit
Public Sub CopyRanges()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets("Arkiv")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets("DN")
Dim IDnum As String
IDnum = TextBox1.Text
Dim idRow As Long
idRow = wsSource.Columns("A:A").Find(What:=IDnum, LookAt:=xlWhole).Row
Dim SourceAddresses() As Variant
SourceAddresses = Array("B" & idRow, "C" & idRow, "D" & idRow, "E" & idRow, "F" & idRow, "G" & idRow, "H" & idRow, "I" & idRow)
Dim DestinationAddresses() As Variant
DestinationAddresses = Array("D9", "E9", "I9", "C20", "D20", "E45", "G20", "H20", "I20")
If UBound(SourceAddresses) <> UBound(DestinationAddresses) Then
MsgBox "Amount of source addresses must be the same amount as destination addresses"
Exit Sub
End If
Dim i As Long
For i = LBound(SourceAddresses) To UBound(SourceAddresses)
wsDestination.Range(DestinationAddresses(i)).Value = wsSource.Range(SourceAddresses(i)).Value
Next i
End Sub
试一试:
Option Explicit
Sub test()
Dim LastRow As Long
Dim strSearchingValue As String
Dim rngSearchingArea As Range, rngFound As Range
'Set the value you are looking for
strSearchingValue = "Test"
'Let us assume that our data appears in Sheet1 - change if needed
With ThisWorkbook.Worksheets("Sheet1")
'Let us assume that IDs appears in column A - Find the last row of column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Let us assume that IDs start from row 2 and end at LastRow - Set the range we want to search
Set rngSearchingArea = .Range("A2:A" & LastRow)
'Use find method to check if there is any match
Set rngFound = rngSearchingArea.Find(strSearchingValue, LookIn:=xlvalues, LookAt:=xlWhole)
'Check the results
If Not rngFound Is Nothing Then
'If there is a match - you get back the row
Debug.Print rngFound.Row
Else
'If there is not a match - you get back a message box
MsgBox "This ID is not appear in the data."
End If
End With
End Sub
我有一个可让您输入 ID 号的用户表单,我希望将具有相应 ID 号的行复制到单元格未对齐的不同工作表中。
我试过使用数组作为数据的目的地,但是当我 运行 它没有做任何事情。我知道我可以用丑陋的方式做到这一点,并将每个单元格编码为转到另一个单元格,但我认为对正在复制的数据使用数组会起作用,现在我需要知道如何将所有目标单元格放在一个单元格中变量并将数据复制到那里
Dim ws As Worksheet
Set ws = Sheets("Arkiv")
Dim DN As Worksheet
Set DN = Sheets("DN")
idRow = Sheets("Arkiv").Columns("A:A").Find(what:=IDnum).Row
IDnum = TextBox1.Text
'Dim shipFrom As Range
'Set shipFrom = Sheets("Arkiv").Range("B" & idRow)
Dim goTo1 As Variant
goTo1 = Array(DN.Range("D9"), DN.Range("E9"), DN.Range("I9"), DN.Range("C20"), DN.Range("D20"), DN.Range("E45"), DN.Range("G20"), DN.Range("H20"), DN.Range("I20"))
Dim data As Variant
data = Array(ws.Range("B" & idRow), ws.Range("C" & idRow), ws.Range("D" & idRow), ws.Range("E" & idRow), ws.Range("F" & idRow), ws.Range("G" & idRow), ws.Range("H" & idRow), ws.Range("I" & idRow))
goTo1 = data
我希望变量 "data to be copied over to the cells inside of the "goTo1" 中的数据按照我将它们放入数组的相应顺序排列。enter code here
如果您使用查找方法,请始终指定
LookAt
参数,否则 VBA 使用上次使用的任何内容(用户或 VBA) .你需要循环遍历地址,一个一个复制。您不能一次复制 non-coninous 个范围。
所以像这样的东西应该有用。
Option Explicit
Public Sub CopyRanges()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets("Arkiv")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets("DN")
Dim IDnum As String
IDnum = TextBox1.Text
Dim idRow As Long
idRow = wsSource.Columns("A:A").Find(What:=IDnum, LookAt:=xlWhole).Row
Dim SourceAddresses() As Variant
SourceAddresses = Array("B" & idRow, "C" & idRow, "D" & idRow, "E" & idRow, "F" & idRow, "G" & idRow, "H" & idRow, "I" & idRow)
Dim DestinationAddresses() As Variant
DestinationAddresses = Array("D9", "E9", "I9", "C20", "D20", "E45", "G20", "H20", "I20")
If UBound(SourceAddresses) <> UBound(DestinationAddresses) Then
MsgBox "Amount of source addresses must be the same amount as destination addresses"
Exit Sub
End If
Dim i As Long
For i = LBound(SourceAddresses) To UBound(SourceAddresses)
wsDestination.Range(DestinationAddresses(i)).Value = wsSource.Range(SourceAddresses(i)).Value
Next i
End Sub
试一试:
Option Explicit
Sub test()
Dim LastRow As Long
Dim strSearchingValue As String
Dim rngSearchingArea As Range, rngFound As Range
'Set the value you are looking for
strSearchingValue = "Test"
'Let us assume that our data appears in Sheet1 - change if needed
With ThisWorkbook.Worksheets("Sheet1")
'Let us assume that IDs appears in column A - Find the last row of column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Let us assume that IDs start from row 2 and end at LastRow - Set the range we want to search
Set rngSearchingArea = .Range("A2:A" & LastRow)
'Use find method to check if there is any match
Set rngFound = rngSearchingArea.Find(strSearchingValue, LookIn:=xlvalues, LookAt:=xlWhole)
'Check the results
If Not rngFound Is Nothing Then
'If there is a match - you get back the row
Debug.Print rngFound.Row
Else
'If there is not a match - you get back a message box
MsgBox "This ID is not appear in the data."
End If
End With
End Sub