Question

我在excel中有一个文件，如下所示：

A _B _C 0.02_0.01_0.01

我只想像这样转置数据：

0.02 B 0.01 C 0.01

我的代码不起作用，我使用复制粘贴方法但失败了。

我的代码：

Do Until y = 60
    If xlApp.ActiveSheet.Cells(X, y).value = "" Then
        xlApp.Range(xlApp.Cells(X + 1, y - 1), xlApp.Cells(X + 1, y - 1)).Select()
        xlApp.Selection.copy()
        xlApp.Range(xlApp.Cells(X, y), xlApp.Cells(X, y)).Select()
        xlApp.ActiveSheet.Paste()

        y = y + 1
    ElseIf xlApp.ActiveSheet.Cells(X, y).value <> "" Then
        y = y + 1
    ElseIf y = 60 Then
        y = 30
        X = X + 1
        Exit Do
    End If
Loop

y是第一列。如果有数据，则无需做任何事情。如果没有数据，请在（下方）之前剪切数据并粘贴在旁边。

Answer 1

Sub test()
Dim x As Long, y As Long
Dim xlApp As Excel.Application
Dim RR As Range
Dim R As Range
Dim srcR As Range, dstR As Range

Set xlApp = GetObject(, "excel.application")

'assume A1 is the address of the first cell in table (aka OTH)

Set RR = xlApp.ActiveSheet.Range("A2")

'there are 30 pairs f rows
For y = 1 To 60 Step 2

    'there are 5 pairs of columns
    For x = 1 To 10 Step 2

        Set R = RR.Cells(y, x)

        'B1 is next column of the current cell
        Set dstR = R.Cells(1, 2)

        'A2 is the next row of current cell
        Set srcR = R.Cells(2, 1)

        If (dstR.Value = "" And srcR.Value <> "") Then
            'do a cut directly to next cell
            srcR.Cut dstR
        End If

    Next x
Next y


'  INPUT
'OTH     PAR     SCR     SLP     TSC
'1       1       1       1       1
'0,2     0,2     0,2     0,2     0,2
'2       2       2       2       2
'0,2     0,2     0,2     0,2     0,2
'3       3       3       3       3
'0,2     0,2     0,2     0,2     0,2
'4       4       4       4       4
'0,2     0,2     0,2     0,2     0,2
'5       5       5       5       5
'0,2     0,2     0,2     0,2     0,2
'6       6       6       6       6
'0,2     0,2     0,2     0,2     0,2
'7       7       7       7       7
'0,2     0,2     0,2     0,2     0,2


' OUTPUT
'OTH     PAR     SCR     SLP     TSC
'1   0,2 1   0,2 1   0,2 1   0,2 1   0,2
'
'2   0,2 2   0,2 2   0,2 2   0,2 2   0,2
'
'3   0,2 3   0,2 3   0,2 3   0,2 3   0,2
'
'4   0,2 4   0,2 4   0,2 4   0,2 4   0,2
'
'5   0,2 5   0,2 5   0,2 5   0,2 5   0,2
'
'6   0,2 6   0,2 6   0,2 6   0,2 6   0,2
'
'7   0,2 7   0,2 7   0,2 7   0,2 7   0,2
'

End Sub

VB6将数据从垂直复制到水平

1 个答案: