【问题标题】:Insert specified text string X amount of times based on cell count and header value根据单元格计数和标题值插入指定的文本字符串 X 次
【发布时间】:2021-05-25 04:14:14
【问题描述】:

已更新 - 添加了屏幕截图/添加了表格

这里是 VBA 的新手,因此很抱歉,因为我确信这是一项简单的任务,但经过研究和测试无济于事。

我正在尝试将标准报告重新格式化为新的文件格式以供上传。我正在尝试根据标题值插入文本值 X 次。每个列标题不同(家属护理;医疗 FSA;HSA),但必须拼写为“家属护理 FSA”或“健康储蓄计划”等,并且必须在同一列(E 列)上运行 X 次不同的工作表。

到目前为止,这是我为此部分编写的一段代码,但似乎无法连续找到刚刚插入的内容的最后一行并继续沿列向下运行。实例的数量每周都会变化,因此希望这是动态的。列标题和值继续从 E1 下降到 J1。值的数量都是一样的,但这些都是每周都在变化的。一周可能有 334 行,下一周可能有 340 行。

NumToRepeat = wksSource.Range("C" & Rows.Count).End(xlUp).Row

    If wksSource.Range("E1").Value = "Pre_Tax_FSA_Dependent_care(DR1)" And wksSource.Range("F1").Value = "Pre_Tax_FSA_Medical(DR1)" Then
                   
        wksDest.Range("E2").Select
        ActiveCell.FormulaR1C1 = "Dependent Care FSA"
        wksDest.Range("E2").Select
        Selection.AutoFill Destination:=wksDest.Range("E2:E" & NumToRepeat)

        wksDest.Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Select
        ActiveCell.FormulaR1C1 = "Medical FSA"
        wksDest.Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Select
        Selection.AutoFill Destination:=wksDest.Range("E" & NumToRepeat + 1, "E" & NumToRepeat * 2 - 1)
                   
    End If
    
End With

我可以让这两个叠加,但不能让其他人叠加。无论我写什么,都只是复制第二个实例......

我只需要帮助来不断找到最后一行并根据列标题中的内容粘贴文本。如果这一切都令人困惑(和基本),我深表歉意,但很高兴进一步澄清并提前真正感谢所有帮助!

Source Data Example

End Result Example

这里是表格形式: 源表数据样本

Paydate EE_Code SSN EE Name DepCareFSA FSAMed HSAemp HSAer Parking Commuter
05/14/2021 ABCD 123456789 JOHN DOE 208.33 0 0 0 0 0
05/14/2021 EFGH 111111111 JANE DOE 0 0 0 38.46 0 0
05/14/2021 IJKL 222222222 JERRY DOE 0 0 0 38.46 0 0
05/14/2021 MNOP 333333333 JILL DOE 115.38 0 190.38 86.54 0 0
05/14/2021 QRST 444444444 JIM DOE 0 0 190.38 86.54 0 0
05/14/2021 UVWX 555555555 JEN DOE 0 0 100 38.46 0 0

尝试重新格式化为此...根据值来自哪个列来填充 C 列和 E 列,F 列是标准的“当前”,一直到所有行。

EmployeeIdentifier ContributionDate ContributionDescription ContributionAmount PlanName PriorTaxYear
123456789 05142021 Payroll 208.33 Dependent Care FSA Current
111111111 05142021 Payroll 0 Dependent Care FSA Current
222222222 05142021 Payroll 0 Dependent Care FSA Current
333333333 05142021 Payroll 115.38 Dependent Care FSA Current
444444444 05142021 Payroll 0 Dependent Care FSA Current
555555555 05142021 Payroll 0 Dependent Care FSA Current

这将继续使用 E 列中的值,然后是 F 列堆叠在下面,依此类推,并根据其来自哪一列列出相应的贡献类型。

我能够设置所有内容(在列中重复 SSN,重复日期......虽然格式不正确,对应值),但无法弄清楚如何获取 C 和 E 列的从属名称以不断查找最后一行,堆叠在一起,同时对应于正确的 SSN 和值...我还没有尝试添加 F 列,它一直表示“当前”,但是这很容易吗?

非常感谢任何和所有帮助。我是一个精通 Excel 的用户,但对 VBA 很陌生,并且一直在努力解决这一切。我已经完成了大约 75% 的路程,但需要这些步骤的帮助...

谢谢!

【问题讨论】:

  • 您想要实现的目标确实令人困惑。您能否发布一些您拥有和需要的示例(如屏幕截图)?
  • 嗨,约翰尼!我添加了截图。第一个图像是源数据,除了假设所有这些“John Do”是不同的个人(或本例中的员工)。第二个屏幕截图是我想要得到的最终结果。我能够将 SSN 复制和粘贴正确的次数、复制和粘贴的日期、复制和粘贴源列中的金额...但是现在尝试根据哪个源在 E 列中添加一个特定值它来自的列,应该链接到每个金额。我也在尝试为 C 列做类似的事情。
  • 添加样本数据是朝着改进此 Q 的正确方向迈出的一步,但仅将其添加为图像没有帮助。当您可以将其作为文本包含时,您会强迫任何试图帮助您重新输入数据的人。此外,您对该数据的解释属于 Q,而不是评论
  • 啊——抱歉!今晚我将对其进行调整,以将其作为文本包含在原始帖子中,以及上面评论中的详细信息。感谢您的帮助!
  • 什么是 X,它是如何确定的?

标签: excel vba


【解决方案1】:

这是您的案例的解决方案。将工作表的名称调整为您需要的名称。帮助器SetTags 函数仅根据标头的值选择适当的名称。它使用ByRef 来直接更改这些变量(而不是使用会返回数组的函数)。在调用SetTags 之前,我们需要清除这些变量——如果您在SetTags 中拼错了一些文本,这将使我们有机会发现错误(在这种情况下,最终工作表上会有空单元格)。如果我们不清除它们并且您拼错了一些文本,您将在最终工作表上得到错误的文本。代码还使用两个范围 - 一个带标题 (rngTable) 和一个不带标题 (rngData)。 rngData 让我们可以轻松地将数据传输到最终工作表,而无需进行任何进一步的计算。最后,由于我们知道要复制的行数始终相同,因此下一行(要插入到最终工作表上)计算为当前下一行加上此行数。

Option Explicit

Sub Transfer()

    Dim wksSource As Worksheet, wksDest As Worksheet
    Dim rngTable As Range, rngData As Range
    Dim rowsCount&, nextRow&, col&
    Dim strContribDesc$, strPlanName$
    
    Set wksSource = Worksheets("SOURCE SAMPLE")
    Set wksDest = Worksheets("FINAL")
    Set rngTable = wksSource.Range("A1").CurrentRegion
    With rngTable: Set rngData = .Offset(1).Resize(.Rows.Count - 1): End With
    nextRow = 2: rowsCount = rngData.Rows.Count
    
    With wksDest
        .[A1].CurrentRegion.Offset(1).EntireRow.Delete '//Delete old data
        For col = 5 To 10
            strContribDesc = vbNullString: strPlanName = vbNullString
            Call SetTags(rngTable.Rows(1).Cells(col), strContribDesc, strPlanName)
            .Cells(nextRow, "A").Resize(rowsCount).Value = rngData.Columns(3).Value   '//EmployeeIdentifier
            .Cells(nextRow, "B").Resize(rowsCount).Value = rngData.Columns(1).Value   '//ContributionDate
            .Cells(nextRow, "C").Resize(rowsCount).Value = strContribDesc             '//ContributionDescription
            .Cells(nextRow, "D").Resize(rowsCount).Value = rngData.Columns(col).Value '//ContributionAmount
            .Cells(nextRow, "E").Resize(rowsCount).Value = strPlanName                '//PlanName
            .Cells(nextRow, "F").Resize(rowsCount).Value = "Current"                  '//PriorTaxYear
            nextRow = nextRow + rowsCount
        Next
    End With
    
    MsgBox "Well done!", vbInformation

End Sub

Private Sub SetTags(strHeader$, ByRef strContribDesc$, ByRef strPlanName$)
    Select Case strHeader
        Case "Pre_Tax_FSA_Dependent_care(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Dependent Care FSA"
        Case "Pre_Tax_FSA_Medical(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Medical FSA"
        Case "Pre_Tax_HSA_Employee(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Health Savings Plan"
        Case "Pre_Tax_HSA_Employer(DR1)"
            strContribDesc = "Employer"
            strPlanName = "Health Savings Plan"
        Case "Parking_Benefit(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Parking"
        Case "Commuter_Benefit(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Parking"
    End Select
End Sub

【讨论】:

  • 非常感谢 - 这太棒了。
猜你喜欢
  • 2013-04-28
  • 2015-07-12
  • 1970-01-01
  • 2017-09-23
  • 1970-01-01
  • 2014-02-20
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多