首页 > 解决方案 > 如何在 excel 宏中编码以将数据作为数据行提取到新工作表(新格式)

问题描述

在附件中,此报告将作为数据行提取到新工作表中,以输入到 ms access 数据库示例输出数据显示在下部。任何人都知道如何在excel宏中做到这一点?谢谢!

标签: excelvba

解决方案


亲爱的@ROMEO SANDOVAL,我尝试为您创建一个代码以提供一些指导。查看工作表结构和输出并修改代码以满足您的需求。

结构与输出:

在此处输入图像描述

代码:

Option Explicit

Sub test()

    Dim LastRowFirst As Long, LastRowNext As Long, LastColumn As Long, i As Long, j As Long
    Dim Subcon As String

    With ThisWorkbook.Worksheets("Sheet1")

          LastRowFirst = .Cells(.Rows.Count, "A").End(xlUp).Row

          'Loop start from row 3 (Row after Description) up to the last row of column A
          For i = 3 To LastRowFirst
            'If range is not empty
            If .Range("A" & i).Value <> "" Then
                If .Range("A" & i).Value = "CSTS" Or .Range("A" & i).Value = "MAMMOET" Or .Range("A" & i).Value = "GTA" Then
                    Subcon = .Range("A" & i).Value
                Else
                    'Loop start from column 3 (where the different spot appears) up to column 5
                    For j = 3 To 4
                        LastRowNext = .Cells(.Rows.Count, "F").End(xlUp).Row
                        .Cells(LastRowNext + 1, 6).Value = Format(Now, "mm/dd/yyyy")
                        .Cells(LastRowNext + 1, 7).Value = Subcon
                        .Cells(LastRowNext + 1, 8).Value = .Range("A" & i).Value
                        .Cells(LastRowNext + 1, 9).Value = .Cells(2, j).Value
                        .Cells(LastRowNext + 1, 10).Value = .Cells(i, j).Value
                    Next j
                End If
            End If
        Next i
    End With

End Sub

推荐阅读