2 столбца на двух разных листах перенесены в третий столбец

Question

Сейчас я работаю над файлом Excel, состоящим из 3 листов. Три листа состоят из следующих, во-первых, листа «Datenquelle», во-вторых, листа «Datenunterschied» и, в-третьих, листа «Daten».

Все три листа содержат идентичные имена столбцов и похожие данные. Я хочу выделить различия данных в «Datenquelle» и «Daten» на листе «Datenunterschied» с помощью макроса VBA.

Контрольной точкой должен быть столбец «Идентификатор».

Как видите, лист «Daten» содержит четыре набора данных со следующими номерами идентификаторов:

6257 - 6258 - 6259 - 6260

Лист «Datenquelle» содержит шесть номеров идентификаторов:

6257 - 6258 - 6259 - 6260 - 6261 - 6268

Цель состоит в том, чтобы все наборы данных, которые не содержатся в листе «Daten», но содержат «Datenquelle», должны быть взяты через макрос VBA в лист "Datenunterschied". В моем примере это будут наборы данных, следующие за идентификаторами «6261» и «6268». Вся ячейка наборов данных «6261» и «6268» должна быть перенесена в «Datenunterschied».

Я пробовал использовать макрос, но он не дал правильного результата.

Sub Unterschied()
Dim CompareRange As Object, x As Object, y As Object
Dim lastRow As Integer

Set CompareRange = Sheets("Datenquelle").Range("H2:H" & Sheets("Datenquelle").Cells(Rows.Count,  _
9).End(xlUp).Row)

    For Each x In Sheets("Daten").Range("H2:H" & Sheets("Daten").Cells(Rows.Count, 9).End(xlUp). _
Row)
        For Each y In CompareRange

        If y <> x Then
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets("Datenunterschied").Cells(lastRow, 9).Value = x.Value
            Sheets("Datenunterschied").Cells(lastRow, 10).Value = x.Offset(0, 1).Value
            Sheets("Datenunterschied").Cells(lastRow, 11).Value = x.Offset(0, 2).Value
            Sheets("Datenunterschied").Cells(lastRow, 8).Value = x.Offset(0, -1).Value
            Sheets("Datenunterschied").Cells(lastRow, 7).Value = x.Offset(0, -2).Value
            Sheets("Datenunterschied").Cells(lastRow, 6).Value = x.Offset(0, -3).Value
            Sheets("Datenunterschied").Cells(lastRow, 5).Value = x.Offset(0, -4).Value
            Sheets("Datenunterschied").Cells(lastRow, 4).Value = x.Offset(0, -5).Value
            Sheets("Datenunterschied").Cells(lastRow, 3).Value = x.Offset(0, -6).Value
            Sheets("Datenunterschied").Cells(lastRow, 2).Value = x.Offset(0, -7).Value
            Sheets("Datenunterschied").Cells(lastRow, 1).Value = x.Offset(0, -8).Value
        End If
        Next y
    Next x
End Sub

Я предоставил данные здесь:

https://www.herber.de/bbs/user/137783.xlsm

Привет, Канимэ

Answer 1

Option Explicit

Sub Difference()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws_data As Worksheet
    Set ws_data = wb.Sheets("Daten")

    Dim ws_dataSource As Worksheet
    Set ws_dataSource = wb.Sheets("Datenquelle")

    Dim ws_dataDiff As Worksheet
    Set ws_dataDiff = wb.Sheets("Datenunterschied")


Dim rSource As Range, rData, rDiff As Range
Dim lastRow As Long

    Set rSource = ws_dataSource.Range("A2:K2") 'this assumes six columns starting at A1. You will need to adjust the A1:F1 part
    Set rData = ws_data.Range("A2:K2")         'again, your range will vary
    Set rDiff = ws_dataDiff.Range("A2:K2")


    Dim x, y As Range 'these are the cell variables we will use to loop through the ranges. you are using object x and y for this task

    For Each x In rSource
        Dim currentIdentifier As String
        currentIdentifier = x.Value 'value to look for in data range
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In rData
            If currentIdentifier = y.Value Then
                foundMatch = True       'this columns needs not to be copied as we have found it in both worksheets
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 1).End(xlUp).Row + 1
            x.Copy (ws_dataDiff.Range("A2:K2")) 'here comes the bit where we actually copy the data
            Debug.Print currentIdentifier
        End If
    Next x
End Sub

Answer 2

Решение проблемы выглядит следующим образом:

Sub Difference()

Dim lastRow As Long
Dim x, y As Object 'Cells which will loop through, but declared as objects.


    For Each x In Sheets("Datenquelle").Range("I2:I" & Sheets("Datenquelle").Cells(Rows.Count, 9).End(xlUp).Row)
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In Sheets("Daten").Range("I2:I" & Sheets("Daten").Cells(Rows.Count, 9).End(xlUp).Row)
            If x.Value = y.Value Then
                foundMatch = True       
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 9).End(xlUp).Row + 1
            Sheets("Datenunterschied").Cells(lastRow, 9).Value = x.Value ' Copying and setting the data in last available free row
            Debug.Print x.Value
        End If
    Next x
End Sub

Answer 3

К сожалению, вашу проблему очень сложно понять, не загрузив лист Excel. Думаю, я понял, что вы хотите, я дам вам общий ответ, который вам придется подправить для вашего личного случая. Также я думал о написании кода, похожего на ваш, но решил переписать его так, чтобы его можно было использовать повторно. Сначала давайте посмотрим, как правильно обращаться к разным листам. Обратите внимание на этот топи c и этот топи c. По сути, сначала мы хотим использовать Option Explicit. Затем мы хотим объявить нашу книгу и наши рабочие листы как переменные и адресовать их безопасным способом.

Итак, наш первый шаг:

Option Explicit

Sub Difference()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws_data As Worksheet
    Set ws_data = wb.Sheets("Daten")

    Dim ws_dataSource As Worksheet
    Set ws_dataSource = wb.Sheets("Datenquelle")

    Dim ws_dataDiff As Worksheet
    Set ws_dataDiff = wb.Sheets("Datenunterschied")
End Sub

Теперь у вас есть столбцы с идентификаторами в ws_dataSource, которые не могут можно найти в ws_data. Поэтому мы проверяем оба листа на наличие разных идентификаторов. Я воспользуюсь вашим подходом, объявив диапазоны, в которых их искать, и затем перебираю их.

    Dim rSource As Range, rData, rDiff As Range
    Set rSource = ws_dataSource.Range("A1:F1")  'this assumes six columns starting at A1. You will need to adjust the A1:F1 part
    Set rData = ws_data.Range("A1:F1")          'again, your range will vary
    Set rDiff = ws_dataDiff.Range("A1:ZZ1")


    Dim x, y As Range 'these are the cell variables we will use to loop through the ranges. you are using object x and y for this task

    For Each x In rSource
        Dim currentIdentifier As String
        currentIdentifier = x.Value 'value to look for in data range
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In rData
            If currentIdentifier = y.Value Then
                foundMatch = True       'this columns needs not to be copied as we have found it in both worksheets
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            'here comes the bit where we actually copy the data
            Debug.Print currentIdentifier
        End If
    Next x

У меня не хватило времени на последний бит, но есть много ресурсов, где можно узнать, как копировать и вставлять столбцы с одного листа на другой. Посмотрите здесь : (это сводится к взятию диапазона x и использованию метода copy. x.copy NewColumn

expression.Copy (Destination)