VBA：将工作表中的多列复制到另一工作表中的一列

Question

我有多个列，它们之间有特定距离，我想将所有数据复制到一个列中。

我有一个变量n=29 。

列之间的距离始终为9。总列数为n*(9+1)=290于"KD"列的磁芯

具有波纹管数据的工作表命名为"Importat"

 |  B  |....|  L  |....|  V  |...| AF |..until.. |  KD  |
---------------------------------------------------------
1|
2|  10 |....| 79  |....| 21  |...| 41 |..........|  22  |
3|  13 |....| 55  |....| 51  |...|    |..........|  56  |
4|  16 |....|     |....|     |...|    |..........|  67  |

结果必须在"COD+DATA"表中是这样的

  |  K  |
 ---------
 1|     |
 2| 10  |
 3| 13  |
 4| 16  |
 5| 79  |
 6| 55  |
 7| 21  |
 8| 51  |
 9| 41  |
.......  
 x| 22  |
 y| 56  |
 z| 67  |

---

有什么建议我该怎么做？

Answer 1

您的示例数据未遵循一致的模式。

Dim y As Long

For y = 2 To 300 Step 10
    Debug.Print Split(Columns(y).Address(False, False), ":")(0); ",";
Next

Answer 2

也许我误解了您的问题，但是据我了解，您在工作簿的Importat表中有数据。 数据在列中，并且列始终被9列分隔（一直到KD列）。 以下是可以使用的一种方法：

Sub GetDataFromImportatSheet()

    Dim oIWS As Worksheet: Set oIWS = ThisWorkbook.Worksheets("Importat")
    Dim oCWS As Worksheet: Set oCWS = ThisWorkbook.Worksheets("COD+DATA")
    Dim intLastColumn As Integer: intLastColumn = oIWS.Cells(2, oIWS.Columns.Count).End(xlToLeft).Column
    Dim intLastRow As Integer
    Dim intColCounter As Integer
    Dim intCurRow As Integer
    Dim intCWSRow As Integer

    intCWSRow = 0

    For intColCounter = 2 To intLastColumn Step 9

        intLastRow = oIWS.Cells(oIWS.Rows.Count, intColCounter).End(xlUp).Row

        For intCurRow = 1 To intLastRow

            If Len(Trim(oIWS.Cells(intCurRow, intColCounter))) <> 0 Then

                intCWSRow = intCWSRow + 1
                oCWS.Cells(intCWSRow, "J").Value = intCWSRow
                oCWS.Cells(intCWSRow, "K").Value = oIWS.Cells(intCurRow, intColCounter)

            End If

        Next

    Next

End Sub

Answer 3

您要做的是重塑数据。 我创建了一个复杂的宏来执行这两种操作，即列表->表和表->列表。 检查一下： http : //amitkohli.com/change-lists-into-tables-and-tables-into-lists/

您可能必须创建一个中间表，其中所有数据彼此相邻，而不是相隔9列。