Excel文件行列格式转换

Eddy Xu 2019/8/19 excel vba

问题来源： ExcelHome http://club.excelhome.net/forum.php?mod=viewthread&tid=1494776

Sub transfer()
Dim newsht As Worksheet
Sheets("原材料").Copy After:=Sheets(1)
Set newsht = ActiveSheet
With newsht
    For i = 2 To newsht.UsedRange.Rows.Count
        If .Cells(i, 1) <> "" Then
            j = 0
            Do
                .Cells(i, 6 + j).Value = .Cells(i + j, 2).Value
                If .Cells(i + j, 3).Value = "Y" Then
                    .Cells(i, 5).Value = .Cells(i, 5).Value & "," & Chr(j + 65)
                End If
                .Cells(i + j, 2).Value = ""
                .Cells(i + j, 3).Value = ""
                j = j + 1
            Loop While Trim(.Cells(i + j, 1).Value) = "" And Trim(.Cells(i + j, 2).Value) <> ""
            .Cells(i, 5).Value = Right(.Cells(i, 5).Value, Len(.Cells(i, 5).Value) - 1)
        End If
    Next
End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22