Question

我正在运行一个VBA宏，该宏将使用您输入的值，将其输入到数据透视表上的过滤器中，然后使用数据透视表结果生成大小为（：，2）并带有分隔符行（选择字段的顶部）移到其他值（作为索引）的右边，然后将结果返回到工作簿中的另一张纸上。

一些重要说明：

所有数据均为str格式
所有索引值都是数字
某些数据值以数字开头
某些部分的索引在数据库中的索引是2倍，而在传递新索引之前，该部分最多具有16个数据点。这就是我原来的代码每8个都不起作用的原因。
结果可能是8个数据点到数百个任何长度，xlDown尚未用于设置范围，所以我只设置了A1：A1000

当前结果：

一切正常，直到我找到具有多个数据集的索引，在这种情况下，我的（Row-2）mod 8 = 0函数被抛出了
在这种情况下，索引已正确复制，并删除了空白行
最终表中的数据被可靠地拉至其他电子表格

我尝试过的一些事情：

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

尝试将值向下拖动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

如果您想了解更多信息，可以随时与我们联系（我还没有做很多这样的事情，所以我不确定该怎么做）

尝试通过将行移动到相邻列来抓取枢轴结果

1 个答案: