excel 将数据转换为平面文件格式

bqf10yzr  于 2023-04-07  发布在  其他
关注(0)|答案(1)|浏览(167)

我写了下面的代码:

Sub RepeatData3()

    ' Declare variables
    Dim dashboard As Worksheet
    Dim flatfile As Worksheet
    Dim lastRowC As Long
    Dim lastRowD As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim Row_Counter As Long
    
    ' Set worksheet variables
    Set dashboard = ThisWorkbook.Sheets("Dashboard_Test")
    Set flatfile = ThisWorkbook.Sheets("Flat File")
    
    ' Find last row with data in column C and D of Dashboard tab
    lastRowC = dashboard.Cells(dashboard.Rows.Count, "C").End(xlUp).Row
    lastRowD = dashboard.Cells(dashboard.Rows.Count, "D").End(xlUp).Row
    
    Row_Counter = 8
    
    ' Loop through each row in column C of Dashboard tab
    For i = 1 To lastRowC
        ' Check if row has data
        If Len(dashboard.Range("C" & i).Value) > 0 Then
            ' Loop through each row of column D of Dashboard tab
            For k = 1 To lastRowD
                ' Check if row has data and does not contain "Total"
                If Len(dashboard.Range("D" & k).Value) > 0 And _
                   UCase(dashboard.Range("D" & k).Value) <> "TOTAL" Then
                   
                    ' Repeat data 30 times in column A and B of Flat File tab
                    For j = 1 To 3
                        flatfile.Range("A" & Row_Counter).Value = dashboard.Range("C" & i).Value
                        flatfile.Range("B" & Row_Counter).Value = dashboard.Range("D" & k).Value
                        Row_Counter = Row_Counter + 1
                    Next j
                'Else
                    ' Break out of For loop with J counter if cell is blank or contains "Total"
                    'Exit For
                End If
            Next k
        End If
    Next i
      
End Sub

我在Dashboard_Test选项卡中有以下数据(源数据)

我需要修改什么才能让平面文件中的输出只重复3次?

当前输出重复列D(来自Dashboard_Test)值3次,但列C(来自Dashboard_Test)值重复的次数与列D相同,而不是3次。
谢谢

vwoqyblh

vwoqyblh1#

简单一点:

Sub RepeatDataN()
    Const NUM_RPT As Long = 3    'use Const for fixed values
    Dim wb As Workbook, dashboard As Worksheet
    Dim flatfile As Worksheet
    Dim i As Long, rwOut As Long, currC, cVal, dVal
    
    Set wb = ThisWorkbook
    Set dashboard = wb.Worksheets("Dashboard_Test")
    Set flatfile = wb.Worksheets("Flat File")
    
    rwOut = 8
    'loop until last row with a D value
    For i = 1 To dashboard.Cells(dashboard.Rows.Count, "D").End(xlUp).Row
        cVal = dashboard.Cells(i, "C").Value
        dVal = dashboard.Cells(i, "D").Value
        If Len(cVal) > 0 Then currC = cVal 'see if we have a (new) C value
        
        If Len(currC) > 0 And Len(dVal) > 0 And UCase(dVal) <> "TOTAL" Then
            'write out rows
            flatfile.Cells(rwOut, "A").Resize(NUM_RPT, 2).Value = Array(currC, dVal)
            rwOut = rwOut + NUM_RPT 'increment output row
        End If
    Next i
End Sub

相关问题