Question

嘿伙计们，我有一份雇主名单，显示Excel 2003工作栏中每dd / mm / yyyy的加固变化。

使用下一个宏我进入同一个文档，每个人的所有GP乘以4.83，表示新列中的结果。

Option Explicit

Sub Resumen()
'------------------
'by Cacho Rodríguez
'------------------
Dim C As Range, Mat, Q&, i&, R&

On Error Resume Next
  Set C = Application.InputBox("Selecciona la celda superior izquierda (CODIGO NÓMINA)" & vbLf & _
    "de tu rango de datos." & vbLf & vbLf & "(por ejemplo: Full1!$A$1)", Type:=8)
  If C Is Nothing Then Exit Sub
On Error GoTo 0

Application.ScreenUpdating = False
With C.Worksheet
  Mat = .Range(C, .Cells(.Rows.Count, 1 + C.Column).End(xlUp).Offset(, 1))
End With
Q = UBound(Mat)
R = 1
Mat(R, 1) = Mat(1, 1)
Mat(R, 2) = Mat(1, 2)
Mat(R, 3) = "GP"

For i = 2 To Q
  Select Case True
    Case Mat(i, 1) = ""
      Mat(R, 3) = 1 + Mat(R, 3)

    Case IsNumeric(Mat(i, 1))
      R = 1 + R
      Mat(R, 1) = 0 + Mat(i, 1)
      Mat(R, 2) = Mat(i, 2)
      Mat(R, 3) = 0
  End Select
Next

C.Worksheet.[g1].CurrentRegion.Delete xlUp
With C.Worksheet.[g1].Resize(R, 3)
  Application.Goto .Cells(1).Offset(, -3), True
  .Value = Mat
  .Columns(4) = "=4.83 * " & .Cells(1, 3).Address(0, 0)
  .Cells(1, 4) = "Total"
  .Resize(, 4).Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

我现在的问题是，我不仅需要新列中的所有GP，我还需要新列中的所有GF以及“总列”中GP + GF * 4.83的结果。但是我需要每个月GP和GF分开，以及每个雇主每月的总数。

例如，下一张图片似乎有些东西：

我该怎么做？

Answer 1

我花了一点时间弄清楚你想做什么。如果我理解正确：第3张图片是第1张图片中的数据摘要，您希望它还包含第2张图片中的数据。

如果这将是一个持续的报告，那么你的第一步应该是更好地组织数据，这将使你在Excel中使用这些数据做任何其他事情更容易为你和他人。

如果您的数据组织如下：

...然后只需点击几下，您就可以自动显示如下数据：

...每次添加或更改数据时，只需单击1次即可更新此表。创建此数据透视表只需几分钟（现在数据已正确组织）。

一个就位，只需点击几下即可更改数据透视表，以便以不同方式立即报告数据。

同样适用于图表（需要几分钟才能创建，并会在数据更改时自动更新）和各种其他Excel功能：

通过使用VBA创建报告，您正在以“艰难的方式”做事 - 但是对于那些不了解Excel内置功能的用户来说，这是非常常见的。但正如我所说，以更合乎逻辑的方式组织数据的第一步（基本上，“每行一条记录”，行之间没有子标题，例如样本数据上的Nom。）

如果您想使用我用于示例的工作簿，您可以download it from Jumpshare here。（它可能无法在JumpShare网站上正确显示（因为图表等），但单击下载按钮下载[无宏] .XLSX文件。

更多信息：

Microsoft： Guidelines for organizing and formatting data on a worksheet
Hubspot：How to Create a Pivot Table in Excel: A Step-by-Step Tutorial (With Video)
Office.com：Create a PivotTable to analyze worksheet data
GCFLearnFree：Introduction to Pivot Tables (with practice workbook)

Answer 2

这是一个宏，它会根据@ashleedawg的建议将您拥有的数据重新排序为更有用的格式。宏使用两个类来帮助进行组合，自记录功能对将来的修改很有用。

重新排序数据后，您可以应用数据透视表来生成您希望的任何类型的报告。对于4,83乘数，您可以将计算字段添加到数据透视表。

而且，如果您愿意，甚至可以录制宏来自动生成数据透视表。

有关课程的信息，请查看Chip Pearson的Introduction to Classes

如各个模块中的评论所述：

务必设置对Microsoft Scripting Runtime
请务必重命名“类模块”
请确保原始和结果数据的工作表在reOrder宏中正确命名

课程模块

Option Explicit
'RENAME cShiftData

Private pCodigo As Long
Private pNom As String
Private pDt As Date
Private pDNI As String
Private pGP As Double
Private pGF As Double
Private pSD As cShiftData
Private pDts As Dictionary

Public Property Get Codigo() As Long
    Codigo = pCodigo
End Property
Public Property Let Codigo(Value As Long)
    pCodigo = Value
End Property

Public Property Get Nom() As String
    Nom = pNom
End Property
Public Property Let Nom(Value As String)
    pNom = Value
End Property

Public Property Get Dt() As Date
    Dt = pDt
End Property
Public Property Let Dt(Value As Date)
    pDt = Value
End Property

Public Property Get DNI() As String
    DNI = pDNI
End Property
Public Property Let DNI(Value As String)
    pDNI = Value
End Property

Public Property Get GP() As Double
    GP = pGP
End Property
Public Property Let GP(Value As Double)
    pGP = Value
End Property

Public Property Get GF() As Double
    GF = pGF
End Property
Public Property Let GF(Value As Double)
    pGF = Value
End Property

Public Property Get Dts() As Dictionary
    Set Dts = pDts
End Property
Public Function addDtsItem(dat As Date)
    If Dts.Exists(dat) Then
        MsgBox "Duplicate key will not be added"
    Else
        Dim V
        Set pSD = New cShiftData
        With pSD
            .GF = Me.GF
            .GP = Me.GP
        End With
        Dts.Add dat, pSD
    End If
End Function

Private Sub Class_Initialize()
    Set pDts = New Dictionary
End Sub

课程模块

Option Explicit
'RENAME cDateData

Private pGP As Double
Private pGF As Double

Public Property Get GP() As Double
    GP = pGP
End Property
Public Property Let GP(Value As Double)
    pGP = Value
End Property

Public Property Get GF() As Double
    GF = pGF
End Property
Public Property Let GF(Value As Double)
    pGF = Value
End Property

常规模块

Option Explicit
'SET REFERENCE TO: Microsoft Scripting Runtime
Sub reOrder()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim cSD As cShiftData, dSD As Dictionary
    Dim I As Long, J As Long
    Dim V As Variant, W As Variant

'set source and results worksheets
'read data into array

Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

Set wsSrc = Worksheets("Sheet1")
V = LastRowCol(wsSrc.Name)
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(V(0), V(1)))
End With

'collect the data
Set dSD = New Dictionary
For I = 1 To UBound(vSrc, 1)
    If Not vSrc(I, 1) Like "*CODIGO*" And _
        Len(vSrc(I, 1)) > 0 Then 'start of a new codigo
            Set cSD = New cShiftData
            With cSD
                .Codigo = vSrc(I, 1)
                .Nom = vSrc(I, 2)
                .DNI = vSrc(I, 3)
            dSD.Add Key:=.Codigo, Item:=cSD
            End With
    ElseIf Len(vSrc(I, 1)) = 0 Then
        With cSD
            .Dt = vSrc(I, 2)
            .GP = vSrc(I, 4)
            .GF = vSrc(I, 5)
            dSD(.Codigo).addDtsItem (.Dt)
        End With
    End If
Next I

'create results array
'one line for each date
I = 0
For Each V In dSD.Keys
    I = I + dSD(V).Dts.Count
Next V

ReDim vRes(0 To I, 1 To 6)

'Header row
vRes(0, 1) = "CODIGO NOMINA"
vRes(0, 2) = "NOM"
vRes(0, 3) = "D.N.I."
vRes(0, 4) = "FECHA"
vRes(0, 5) = "GP"
vRes(0, 6) = "GF"

I = 0
For Each V In dSD.Keys
    With dSD(V)
        For Each W In .Dts
            I = I + 1
            vRes(I, 1) = .Codigo
            vRes(I, 2) = .Nom
            vRes(I, 3) = .DNI
            vRes(I, 4) = W
            vRes(I, 5) = .Dts(W).GP
            vRes(I, 6) = .Dts(W).GF
        Next W
    End With
Next V

'write the results
Application.ScreenUpdating = False
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1) + 1, columnsize:=UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .Columns(4).NumberFormat = "dd/mm/yyyy"
    .Columns(1).HorizontalAlignment = xlCenter
    With .EntireColumn
        .ColumnWidth = 255
        .AutoFit
    End With
End With

myPivot wsRes

Application.ScreenUpdating = True

End Sub

Function LastRowCol(Worksht As String) As Long()
Application.Volatile
    Dim WS As Worksheet, R As Range
    Dim LastRow As Long, LastCol As Long
    Dim L(1) As Long
Set WS = Worksheets(Worksht)
With WS
    Set R = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByRows, _
                    searchdirection:=xlPrevious)

    If Not R Is Nothing Then
        LastRow = R.Row
        LastCol = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByColumns, _
                    searchdirection:=xlPrevious).Column
    Else
        LastRow = 1
        LastCol = 1
    End If
End With

L(0) = LastRow
L(1) = LastCol
LastRowCol = L
End Function

原始数据

重新订购数据 （运行宏之后）

示例数据透视表

在VBA中分开几个月

2 个答案:

更多信息：