EXCEL VBA 二维表转换成一维表

EXCEL VBA  二维表转换成一维表  

Sub 按钮2_Click()

    Rem 初始化
    
    Worksheets(1).Activate
    Dim sizeArr(5)
    sizeArr(0) = "XS"
    sizeArr(1) = "S"
    sizeArr(2) = "M"
    sizeArr(3) = "L"
    sizeArr(4) = "XL"
    
    
    Dim col, row, productNum, refCol, targetRow
    
    targetRow = 1
    
    Sheet2.Range("A1:A65536").Clear
    
    Dim iA As Integer
    
    
    Rem 交叉表转一维表
    For row = 3 To 65536: Rem 处理行
    
        If StrComp(Sheet1.Cells(row, 1), "") = 0 Then GoTo line: Rem 如果为空就中止处理
        
        iA = Asc(Left(Sheet1.Cells(row, 1), 1))
        Rem 如果不是英文字符开头,就跳过
        If (iA >= 65 And iA <= 90) Or (iA >= 97 And iA <= 122) Then
        
            For col = 3 To 7: Rem 处理列
                productNum = Sheet1.Cells(row, 1) & Left(Sheet1.Cells(row, 2), 2)
                       
                Rem 取尺码对照表列号
                If StrComp(Left(productNum, 1), "K") = 0 Then
                    refCol = 4
                ElseIf StrComp(Left(productNum, 1), "B") = 0 Then
                    refCol = 3
                ElseIf StrComp(Left(productNum, 1), "C") = 0 Then
                    refCol = 3
                Else
                    refCol = 2
                End If
               
                productNum = productNum & Sheet3.Cells(col - 1, refCol)
                
                Rem 取铺货件数，如果<=0，就跳过，否则插入一维表
                If Sheet1.Cells(row, col) > 0 Then
                    Sheet2.Cells(targetRow, 1) = productNum & "," & Sheet1.Cells(row, col)
                    targetRow = targetRow + 1
                End If
                
            Next
         End If
line:
    Next
    If targetRow = 1 Then
        Worksheets(1).Activate
        MsgBox "二维表没有数据！"
    Else
        Sheet2.Range("D4").Value = targetRow - 1
        Worksheets(2).Activate
        MsgBox "生成成功！"
    End If
    
End Sub