EXCEL VBA 二维表转换成一维表

来源:互联网 发布:数值是优化算法与理论 编辑:程序博客网 时间:2024/05/09 14:19
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 Ifline:    Next    If targetRow = 1 Then        Worksheets(1).Activate        MsgBox "二维表没有数据!"    Else        Sheet2.Range("D4").Value = targetRow - 1        Worksheets(2).Activate        MsgBox "生成成功!"    End If    End Sub

原创粉丝点击