重新格式化excel布局

Question

我希望我可以解释得很好。
我有一个excel文档已经这样布置;

 A  B  C  D  ...  n 
1 [  ][ H ][ H ][ H ][ ... ][ H ] 
2 [  ][ T ][ T ][ T ][ ... ][ T ] 
3 [ C ][ D ][ D ][ D ][ ... ][ D ] 
4 [ C ][ D ][ D ][ D ][ ... ][ D ] 
5 [ C ][ D ][ D ][ D ][ ... ][ D ] 
. [ ... ][ ... ][ ... ][ ... ][ ... ][ D ] 
n [ C ][ D ][ D ][ D ][ D ][ D ] 

H：主要头
T：名称
C：侧总
d：数据（一些也可以是空白的）

我需要将其转换成可以利用的格式由数据库。我知道我想将它转换成什么，但我不知道如何去做（使用vba或其他选择）。
我想要的是;

 A  B  C  D 
1 [ C ][ T ][ H ][ D ] 
2 [ C ][ T ][ H ][ D ] 
3 [ C ][ T ][ H ][ D ] 
. [ ... ][ ... ][ ... ][ ... ] 
n [ C ][ T ][ H ][ D ] 

如何，我认为它可以做的是遍历可行的区域（全部表示为“d”“数据”的），检查以确保是包含在它的数据（如果不是不打印该行），然后获取其各自的标题并打印出最终产品，可以通过覆盖以前的数据或将其放在不同的工作表上。

谢谢！任何帮助表示赞赏。

Answer 1

这里是一个完整的工作代码（我的样品中至少）：

Option Explicit 

Sub convert_for_DB() 
Dim lLastRow As Long, lLastCol As Long 
Dim c As Range 
Dim index As Long 
Dim aH As Variant, aT As Variant, aC As Variant 
Dim vValues() As Variant 

With Worksheets("Sheet1") 
    'find the last row and the last col 
    lLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
    'get the headers 
    aH = .Range("B1", .Cells(1, lLastCol)).Value 
    aT = .Range("B2", .Cells(2, lLastCol)).Value 
    aC = .Range("A3", .Cells(lLastRow, 1)).Value 
    'create an array with the number of values 
    ReDim vValues((lLastRow - 2) * (lLastCol - 1), 3) 

    index = 0 
    'parse every value of the array 
    For Each c In .Range("B3", .Cells(lLastRow, lLastCol)) 
     If Len(c.Value) > 0 Then 
      vValues(index, 0) = aC(c.Row - 2, 1) 
      vValues(index, 1) = aH(1, c.Column - 1) 
      vValues(index, 2) = aT(1, c.Column - 1) 
      vValues(index, 3) = c.Value 
      index = index + 1 
     End If 
    Next c 
End With 

'store back the data to another sheet 
With Worksheets("Sheet2") 
    .Range("A1", .Cells(UBound(vValues, 1), 4)) = vValues 
End With 
End Sub 

Answer 2

这应该工作（这是快速和肮脏所以不一定有用，如果在你的问题中描述的设置是不完全） - 您需要用实际的表名替换Sheet1和Sheet2。

Public Sub runMeOnce() 

    Dim sourceSheet As String 
    Dim destinationSheet As String 
    Dim i As Long 
    Dim j As Long 
    Dim destinationRow As Long 
    Dim originalData As Variant 
    Dim destinationData As Variant 

    sourceSheet = "Sheet1" 
    destinationSheet = "Sheet2" 

    originalData = Sheets(sourceSheet).UsedRange 
    ReDim destinationData(1 To (UBound(originalData, 1) - 2) * (UBound(originalData, 2) - 1) + 1, 1 To 4) As Variant 

    destinationData(1, 1) = "Side Header" 
    destinationData(1, 2) = "Title" 
    destinationData(1, 3) = "Header" 
    destinationData(1, 4) = "Data" 

    destinationRow = 2 
    For i = 3 To UBound(originalData, 1) 
    For j = 2 To UBound(originalData, 2) 
     destinationData(destinationRow, 1) = originalData(i, 1) 
     destinationData(destinationRow, 2) = originalData(2, j) 
     destinationData(destinationRow, 3) = originalData(1, j) 
     destinationData(destinationRow, 4) = originalData(i, j) 
     destinationRow = destinationRow + 1 
    Next j 
    Next i 

    Sheets(destinationSheet).Cells(1, 1).Resize(UBound(destinationData, 1), UBound(destinationData, 2)) = destinationData 

End Sub 

Answer 3

那么它看起来像这些精等人已经击败了我一记重拳，但这里是我的版本：

Sub FormatData() 
    Dim newRowCount 
    Dim currentCell 
    Dim startCell 
    Dim numDataRows 
    Dim numDataCols 
    Dim i 
    Dim j 

    newRowCount = 0 
    numDataRows = Sheet1.UsedRange.Rows.Count - 2 
    numDataCols = Sheet1.UsedRange.Columns.Count - 1 

    Set startCell = Sheet1.Cells(3, 2) 

    For i = 0 To numDataRows - 1 
     For j = 0 To numDataCols - 1 
      Set currentCell = startCell.Offset(i, j) 
      If startCell.Offset(i, j) <> "" Then 
       newRowCount = newRowCount + 1 
       Sheet2.Cells(newRowCount, 1).Value = Sheet1.Cells(currentCell.Row, 1).Value 
       Sheet2.Cells(newRowCount, 2).Value = Sheet1.Cells(2, currentCell.Column).Value 
       Sheet2.Cells(newRowCount, 3).Value = Sheet1.Cells(1, currentCell.Column).Value 
       Sheet2.Cells(newRowCount, 4).Value = currentCell.Value 
      End If 
     Next j 
    Next i 
End Sub