excel - 尝试通过将行移动到相邻列来抓取数据透视结果

Question

我正在运行一个 VBA 宏，它接受您输入的值，将其输入数据透视表上的过滤器，然后使用数据透视表结果生成一个大小为 (:,2) 且分隔行 (选择字段中的顶部)带到其他值(作为索引)的右侧，然后将结果返回到工作簿中的不同工作表。

一些重要注意事项:

1. 所有数据均为 str 格式
2. 所有索引值都是数字
3. 某些数据值以数字开头
4. 某些索引在数据库中列出两次的部分在传递新索引之前最多有 16 个数据点。这就是我原来的每 8 个代码不起作用的原因。
5. 结果可能是从 8 个数据点到数百个数据点的任意长度，xlDown 无法设置范围，所以我只设置 A1:A1000

当前结果:

1. 一切似乎都正常，直到我遇到具有多个数据集的索引，在这种情况下，我的 (Row-2) mod 8 = 0 函数被抛出
2. 在这些情况下，索引可以正确复制并删除空白行
3. 决赛表中的数据可靠地提取到其他电子表格

我尝试过的一些事情:

1. IsNumeric 似乎解析以数字开头的字符串并将其作为 True 丢弃
2. 因为并非所有值都包含 8 个数据点，所以如果索引不是数字但仍处于正确的索引，我尝试添加调整值来修复索引

3. 尝试将值向下拖动 16 行，这样如果找到数字，它将覆盖。这不起作用。

   ActiveSheet.PivotTables("PivotTable1").PivotFields("searchcode").CurrentPage = Sheets("report").Range("B4").Value
       Range("A5:A1000").Select
       Selection.copy
       Sheets("scratch").Select
       Range("A1").Select
       ActiveSheet.Paste
       ActiveSheet.Range("A1", "A1000").Select
   
       Dim Myrange As Range
       Dim Myrow As Range
       Dim Adjust As Integer
       Adjust = 2
       Set Myrange = Selection
       For Each Myrow In Myrange.Rows
           If IsNumeric(Myrow.Row) And ((Myrow.Row = Adjust Or (Myrow.Row - Adjust) Mod 9 = 0)) Then
   
               Sheets("scratch").Range("B" & Myrow.Row + 1).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 2).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 3).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 4).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 5).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 6).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 7).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 8).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 9).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 10).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 11).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 12).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 13).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 14).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 15).Value() = Range("A" & Myrow.Row).Value()
               Sheets("scratch").Range("B" & Myrow.Row + 16).Value() = Range("A" & Myrow.Row).Value()
   
               Range("A" & Myrow.Row).Clear
   
           ElseIf (Not (IsNumeric(Myrow.Row))) And ((Myrow.Row = Adjust Or (Myrow.Row - Adjust) Mod 9 = 0)) Then
   
               Adjust = Adjust + 1
   
           End If
   
       Next Myrow
   
       Application.CutCopyMode = False
       ActiveSheet.Range("A1:A1000") = [index(lower(A1:A1000),)]
       ActiveSheet.Range("A1:A1000") = [index(trim(A1:A1000),)]
       ActiveSheet.Range("A1:A1000").Select
       Selection.Replace What:="(blank)", Replacement:="", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
       Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
       Selection.Replace What:="â€", Replacement:="", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
       Selection.Replace What:="~*", Replacement:="", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
   

为此，我的数据透视表如下所示:

Filter 1 (All)  
Filter 2 (Code)  

Row Labels  
Index 1  
data1  
data2  
data3  
data4  
data5  
data6  
data7  
data8  
Index 2  
data1  
data2  
data3  
data4  
data5  
data6  
data7  
data8  
Index 3  
data1  
data2  
data3  
...  

我想要什么:

Filter 1 (All)  
Filter 2 (Code)  

Row Labels  
data1 Index1  
data2 Index1  
data3 Index1  
data4 Index1  
data5 Index1  
data6 Index1  
data7 Index1  
data8 Index1  
data1 Index2  
data2 Index2  
data3 Index2  
data4 Index2  
data5 Index2  
data6 Index2  
data7 Index2  
data8 Index2  
data1 Index3  
data2 Index3  
data3 Index3  
...

Answer 1

因此，我决定采取不同的方向，通过错误处理来测试数字或字符串单元格内容。然后，我在 Variant 类型上使用 IsNumeric 来查看是否应将值带入单元格。

    Dim Myrange As Range
    Dim Myrow As Range
    Dim Temp As Variant
    Dim NextTemp As Variant

    Set Myrange = Selection
    For Each Myrow In Myrange.Rows
        NextTemp = Range("A" & Myrow.Row).Value
        If IsEmpty(Range("A" & Myrow.Row)) Then
          Exit For
        ElseIf IsNumeric(NextTemp) Then
            Temp = NextTemp
            Range("A" & Myrow.Row).Value = ""
        Else
            Range("B" & Myrow.Row).Value = Temp
                End If
    Next Myrow

如果您想了解更多信息，请随时与我们联系(我还没有做过很多这样的事情，所以我不知道如何做到这一点)