VBA / Excel - Миграция набора данных на основе «матрицы» в базу данных

Question

Я пытаюсь перенести набор данных из старой системы на основе электронных таблиц в базу данных.И у меня есть еще одна нерешенная проблема.

У меня есть лист в электронной таблице, который действует как таблица «многие ко многим»:

• У него есть имена столбцов
• Также имеется ведущий столбец в виде rowID / Имя, делающее строки уникальными

• На пересечении строк и столбцов у меня есть либо пустая ячейка, либо 'X' (X работал встарая система как отношение между двумя различными наборами данных)

  Rows_name | Column_name1 | Column_name2 | Column_nameX

  Row_name1 ||X |X

  Row_name2 |X ||

  Row_name3 |X |X |X

Для каждого найденного 'X' мне нужно скопировать Row_name и Column_name на отдельный лист, готовый для экспорта.

IE Для Row_name3 это будет три новые строки вновый лист с именем Row_name3 содержит три символа «X»

Rows_name|Column_name

Row_name3|Column_name1

Row_name3|Column_name2

Row_name3|Column_name3

По сути, я решаю отношение многих ко многим, имея третью таблицу.

Поэтому я ищу помощь по алгоритму длянайти все связанные имена столбцов / строк для каждого 'X'.

За любые предложения, как решить эту проблему, я был бы очень признателен.

Answer 1

Это то, что вы пытаетесь?

Option Explicit

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim LRI As Long, LRO As Long, i As Long, j As Long

    '~~> Input Sheet
    Set wsInput = Sheets("Sheet1")
    LRI = wsInput.Range("A" & wsInput.Rows.Count).End(xlUp).Row

    '~~> Output Sheet
    Set wsOutput = Sheets("Sheet2")
    LRO = 2

    For i = 2 To LRI
        With wsInput
            For j = 1 To 3
                If UCase(Trim(.Range("A" & i).Offset(, j).Value)) = "X" Then
                    .Range("A" & i).Copy wsOutput.Range("A" & LRO)
                    .Range("A1").Offset(, j).Copy wsOutput.Range("B" & LRO)
                    LRO = LRO + 1
                End If
            Next
        End With
    Next i
End Sub

СНАПШОТ