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複製到單獨的工作表以準備導出。

I.E.對於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 

快照