Копирование строки с соответствующим идентификационным номером в другой лист - PullRequest
Новая
       24

Копирование строки с соответствующим идентификационным номером в другой лист

0 голосов
/ 10 июля 2019

У меня есть пользовательская форма, которая позволяет вам вводить идентификационный номер, я хочу, чтобы строка с соответствующим идентификационным номером была скопирована на другой лист, где ячейки не выровнены.

Я пытался использоватьмассив для назначения данных, но он ничего не делает, когда я запускаю его.Я знаю, что мог бы сделать это безобразно и кодировать каждую отдельную ячейку, чтобы перейти в другую ячейку, но я подумал, что использование массива для копируемых данных будет работать, теперь мне нужно знать, как я могу поместить все ячейки назначения в однуvarable и скопируйте туда данные 

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" будут скопированы в ячейки внутри переменной "goTo1" в соответствующем порядке. Я поместил их в массив с. enter code here

Ответы [ 2 ]

1 голос
/ 10 июля 2019

Попробуйте: 

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
1 голос
/ 10 июля 2019

  1. Если вы используете метод поиска, всегда указывайте LookAt patameter, в противном случае VBA использует то, что использовалось в прошлый раз (пользователем или VBA).

  2. Вам нужно перебрать адреса и скопировать их один за другим. Вы не можете копировать неконусные диапазоны сразу.

Так что-то вроде этого должно работать. 

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
...