Question

我已通过VBA将数据从一张纸移到另一张纸。我想使用Tableau可视化数据。但是它只能读取水平数据。我需要年份来自我循环，然后在数据旁边插入数据，如下图所示。如果需要，我在最后一部分中添加了用于移动数据的代码。我需要通过VBA而不是使用转置功能来实现这一点。

图片是我想要的样子的一个例子。“我寻求的结果”

已添加编辑

：

    Sub MyProcedure()
a = Worksheets("ark1").Cells(Rows.Count, 1).End(xlUp).Row

MsgBox (a)

End Sub

Private Sub CommandButton1_Click()
Dim nøgletal As String, år As Integer
    Worksheets("Ark2").Select
    nøgletal = Range("B2")
    år = Range("C2")
    Worksheets("Ark1").Select
    Worksheets("Ark1").Range("A4").Select
    ThisWorkbook.Worksheets("Ark1").Range("C1:C100").Value = ThisWorkbook.Worksheets("Ark2").Range("C12:C100").Value
    ThisWorkbook.Worksheets("Ark1").Range("D1:D100").Value = ThisWorkbook.Worksheets("Ark2").Range("D12:D100").Value
   ThisWorkbook.Worksheets("Ark1").Range("E1:E100").Value = ThisWorkbook.Worksheets("Ark2").Range("M12:M100").Value
   ThisWorkbook.Worksheets("Ark1").Range("F1:F100").Value = ThisWorkbook.Worksheets("Ark2").Range("N12:N100").Value
   ThisWorkbook.Worksheets("Ark1").Range("G1:G100").Value = ThisWorkbook.Worksheets("Ark2").Range("O12:O100").Value
   ThisWorkbook.Worksheets("Ark1").Range("A1:A16").Value = ThisWorkbook.Worksheets("Ark2").Range("A12:A16").Value
    If Worksheets("Ark1").Range("A4").Offset(1, 0) <> "" Then
    Worksheets("Ark1").Range("A4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = nøgletal
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = år
    Worksheets("Ark2").Select
    Worksheets("Ark2").Range("B2", "B16").Select
End Sub

Answer 1

我在VBA中创建了一个新版本，该版本可以实现您的期望。知道系统何时停止搜索的流程是基于内容的，因此，尽管年度内容的左侧列为空白，系统将继续搜索，但是当找到一个值（例如Science）时，它将停止搜索。第一部分是一个示例，说明如何调用该函数以指定源和目标工作表以及可以在其中找到范围的整数值：

Private Sub TestingCall()
    Call SpecialTranspose("Ark2", "Ark1", 1, 5)
End Sub

Private Sub SpecialTranspose(strSRCSheet As String, strDSTSheet As String, lngRow As Long, lngCol As Long)
    Dim iRow, iCol As Long
    Dim dstRow, dstCol As Long

    dstRow = 1
    dstCol = 1

    iRow = lngRow + 1
    While Len(Sheets(strSRCSheet).Cells(iRow, lngCol - 1).Value) = 0
        iCol = lngCol
        While Len(Sheets(strSRCSheet).Cells(iRow, iCol).Value) > 0
            Debug.Print iRow, iCol
            Sheets(strDSTSheet).Cells(dstRow, dstCol).Value = Sheets(strSRCSheet).Cells(lngRow, iCol).Value
            Sheets(strDSTSheet).Cells(dstRow, dstCol + 1).Value = Sheets(strSRCSheet).Cells(iRow, iCol).Value
            dstRow = dstRow + 1
            iCol = iCol + 1
        Wend
        iRow = iRow + 1
    Wend
End Sub

Answer 2

基于带有彩色单元格的图像以及您要查找的内容。这就是你所显示的

    Sub x()

Dim lngDataColumns As Long
Dim lngDataRows As Long

lngDataColumns = 3
lngDataRows = 4

For t = 1 To lngDataRows

Range("l2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
        Application.Transpose(Range("e1:g1").Value)

Range("M2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
        Application.Transpose(Range("e1:g1").Offset(t).Value)

Next t

End Sub

如何使用VBA将垂直数据转换为水平数据？

2 个答案: