【问题标题】:VB6 copy data from vertical to horizontalVB6从垂直复制数据到水平
【发布时间】:2015-11-06 07:28:04
【问题描述】:

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

A _B _C 0.02_0.01_0.01

我只想像这样转置数据:

A 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 是第一列。如果有数据,则无需执行任何操作。如果没有数据,则在前面(下面)剪切数据并粘贴到旁边。

【问题讨论】:

    标签: excel vb6


    【解决方案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
    

    【讨论】:

    • 我假设表头和第一个数据行之间没有空行
    猜你喜欢
    • 1970-01-01
    • 2010-09-30
    • 2015-01-05
    • 2016-10-07
    • 2013-08-09
    • 2020-02-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多