vbscript 此宏需要一个百分比交叉表(带有标题,在“最左边的列”处“总计”)并在新工作表上返回一个新的索引表,

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了vbscript 此宏需要一个百分比交叉表(带有标题,在“最左边的列”处“总计”)并在新工作表上返回一个新的索引表,相关的知识,希望对你有一定的参考价值。

Sub IndexCreator()

Dim rng, totrng As Range
Dim orignam, newnam As String
Dim tots() As Variant
Dim i, j As Long

orignam = ActiveSheet.Name
Set rng = Application.InputBox("Please select source table area (include headers)", "Source table", Default:=Selection.Address, Type:=8)


Sheets.Add(After:=Sheets(Sheets.Count)).Name = "IFull" & Format(Date, "dd-mm-yy") & "@" & Format(Time, "hhmmss")
newnam = "IFull" & Format(Date, "dd-mm-yy") & "@" & Format(Time, "hhmmss")

nrow = rng.Rows.Count
ncol = rng.Columns.Count

Debug.Print nrow
Debug.Print ncol

Set totrng = Range(rng.Cells(2, ncol), rng.Cells(nrow, ncol))
Debug.Print totrng.Address

tots = totrng.Value

'Debug.Print LBound(tots)
'Debug.Print UBound(tots)

i = 1
Debug.Print rng.Cells(i + 1, 2).Value
Debug.Print tots(1, 1)

For j = 1 To ncol - 1
    For i = 1 To nrow - 1
        Worksheets(newnam).Cells(i + 1, j + 1).Value = Indexer(rng.Cells(i + 1, j + 1).Value, tots(i, 1))
    Next
Next

Range(rng.Cells(1, 1), rng.Cells(1, ncol)).Copy
Worksheets(newnam).Range(Cells(1, 1), Cells(1, ncol)).PasteSpecial (xlPasteValues)

Range(rng.Cells(1, 1), rng.Cells(nrow, 1)).Copy
Worksheets(newnam).Range(Cells(1, 1), Cells(nrow, 1)).PasteSpecial (xlPasteValues)

End Sub

Function Indexer(X, Total) As Long

Indexer = X / Total * 100

End Function

以上是关于vbscript 此宏需要一个百分比交叉表(带有标题,在“最左边的列”处“总计”)并在新工作表上返回一个新的索引表,的主要内容,如果未能解决你的问题,请参考以下文章

有没有办法计算交叉表数据框与熊猫中另一个数据框之间的比率?

tableau可视化数据分析60讲(十四)-tableau可视化视图(交叉表&项目符号图)

带有交叉表的 Postgres 数据透视表

带有Sum的Oracle SQL交叉表

运行带有排除项的宏多张工作表

带有计数和百分比的 expss mdset 表