Question

我有一个看起来像这样的表：

@PropertySource("file:target/application-int.properties")
@Configuration
@ComponentScan(basePackages = { "org.adam.rest" })
@EnableWebMvc
public class MySpringWebApplicationContext
        extends AnnotationConfigWebApplicationContext {
}

我想生成一个像这样的表：

  +-------+------------+------------+------------+
1 | Company | Invoice # | Employee 1  | Employee 2 |
  +=======+============+============+============+
2 | A       | 12345     | 10 hours    | 2 hours    | 
3 | A       | 23456     | 8 hours     | 3 hours    | 
4 | A       | 34567     | 4 hours     | 4 hours    |

基本上，我只希望每个员工的工作时间有一个“雇员”列和一个单独的行。是否有VBA解决方案或公式，可以用来帮助我做到这一点？提前致谢。

Answer 1

这可能有点高级，但是类似的东西应该对您有用。我在代码中添加了注释，希望可以帮助解释它的作用以及原因，并让您从中学习：

Sub tgr()

    'Declare variables
    Dim wb As Workbook              'Workbook containing the sheets
    Dim wsData As Worksheet         'Worksheet containing the source data
    Dim wsDest As Worksheet         'Worksheet used as destination for results output
    Dim aData() As Variant          'Array variable that will hold the source data
    Dim aResults() As Variant       'Array variable that will hold the results
    Dim lEmployeeHoursCount As Long 'Count of populated employee hours in source data table
    Dim iyData As Long              'Row (vertical) placeholder for aData array         (iy = index of vertical)
    Dim ixData As Long              'Column (horizontal) placeholder for aData array    (ix = index of horizontal)
    Dim iyResult As Long            'Row (vertical) placeholder for aResults array      (iy = index of vertical)

    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("Sheet1")    'Change the sheet name to the actual sheet name

    'Get source data
    With wsData.Range("A1").CurrentRegion
        'Verify data exists
        If .Rows.Count = 1 Then Exit Sub    'No data
        aData = .Value
        'Verify employee hours are populated
        With .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
            lEmployeeHoursCount = .Cells.Count - WorksheetFunction.CountBlank(.Cells)
            If lEmployeeHoursCount = 0 Then Exit Sub    'No populated employee hours
            ReDim aResults(1 To lEmployeeHoursCount, 1 To 4)
        End With
    End With

    'Loop through the employee hours section of the source data table
    For iyData = 2 To UBound(aData, 1)
        For ixData = 3 To UBound(aData, 2)
            'Verify the employee hour cell is populated
            If Len(Trim(aData(iyData, ixData))) > 0 Then
                'Found to be populated, convert to the Result format and add it to Result array
                iyResult = iyResult + 1
                aResults(iyResult, 1) = aData(iyData, 1)    'Company
                aResults(iyResult, 2) = aData(iyData, 2)    'Invoice #
                aResults(iyResult, 3) = aData(1, ixData)    'Employee Name
                aResults(iyResult, 4) = Trim(Replace(aData(iyData, ixData), "hours", vbNullString, , , vbTextCompare))  'Hours, but only the number
            End If
        Next ixData
    Next iyData

    'Verify result data exists
    If iyResult > 0 Then
        'Check if Destination worksheet exists already
        On Error Resume Next
        Set wsDest = wb.Sheets("Results")
        On Error GoTo 0
        If wsDest Is Nothing Then
            'Create worksheet if it doesn't already exists
            Set wsDest = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            wsDest.Name = "Results"
            With wsDest.Range("A1").Resize(, UBound(aResults, 2))
                .Value = Array("Company", "Invoice #", "Employee", "Hours")
                .Font.Bold = True
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
            End With
        Else
            'Worksheet exists, clear previous results
            wsDest.Range("A1").CurrentRegion.Offset(1).ClearContents
        End If
        'Populate results
        wsDest.Range("A2").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults
        wsDest.Range("A1").CurrentRegion.EntireColumn.AutoFit
    End If

End Sub

如何使用宏：

复制将在其上运行宏的工作簿的副本
- 总是在工作簿副本上运行新代码，以防万一代码运行不顺利
- 对于删除任何内容的任何代码尤其如此
在复制的工作簿中，按ALT + F11打开Visual Basic编辑器
插入|模块
复制提供的代码并粘贴到模块中
关闭Visual Basic编辑器
在Excel中，按ALT + F8弹出要运行的可用宏列表
双击所需的宏（我将其命名为tgr）

Answer 2

我会做这样的事情：

我们在J列中输入的公式将取决于右侧的设置（绿色区域）。我们总是有两个条目。一个代表“雇员1”，另一个代表“雇员2”。然后，我们可以填写索引匹配数组公式：

{=LEFT(INDEX($C$2:$D$4,MATCH(1,--($B$2:$B$4=H3),0),MATCH(1,--($C$1:$D$1=I3),0)),FIND(" ",INDEX($C$2:$D$4,MATCH(1,--($B$2:$B$4=H3),0),MATCH(1,--($C$1:$D$1=I3),0)))-1)}

它包含两个公式：

1-公式1：=INDEX($C$2:$D$4,MATCH(1,--($B$2:$B$4=H3),0),MATCH(1,--($C$1:$D$1=I3),0)) 在哪里我们首先找到行值$B$2:$B$4=H3，然后在检查哪一列$C$1:$D$1=I3之后，我们期望在其中找到结果。

2-上面的公式也将获得“小时数”，因此我们需要使用以下方法来消除它们：=LEFT(Formula1 ,FIND(" ",Formula1)-1)。然后我们只剩下数字。

如果我们很懒，我们可以编写一些代码为我们设置绿色表格，然后将公式也粘贴到代码中。代码是在上图中的各列之后编写的，因此可能需要根据您的西装进行调整。

VBA代码：

Sub DuplicateValuesAndPasteFormula()

Dim i As Long
Dim lrow As Long

lrow = Cells(Rows.Count, 7).End(xlUp).Row + 1

For i = 2 To 4
    Cells(lrow, 7).Value = Cells(i, 1).Value 'Copy Company
    Cells(lrow + 1, 7).Value = Cells(i, 1).Value 'Duplicate Company
    Cells(lrow, 8).Value = Cells(i, 2).Value 'Copy Invoice
    Cells(lrow + 1, 8).Value = Cells(i, 2).Value 'Duplicate invoice
    Cells(lrow, 9).Value = Cells(1, 3).Value 'Copy Employee 1
    Cells(lrow + 1, 9).Value = Cells(1, 4).Value 'Copy Employee 2
    Cells(lrow, 10).FormulaArray = _
        "=LEFT(INDEX(R2C3:R4C4,MATCH(1,--(R2C2:R4C2=RC[-2]),0),MATCH(1,--(R1C3:R1C4=RC[-1]),0)),FIND("" "",INDEX(R2C3:R4C4,MATCH(1,--(R2C2:R4C2=RC[-2]),0),MATCH(1,--(R1C3:R1C4=RC[-1]),0)))-1)"
    Cells(lrow + 1, 10).FormulaArray = _
        "=LEFT(INDEX(R2C3:R4C4,MATCH(1,--(R2C2:R4C2=RC[-2]),0),MATCH(1,--(R1C3:R1C4=RC[-1]),0)),FIND("" "",INDEX(R2C3:R4C4,MATCH(1,--(R2C2:R4C2=RC[-2]),0),MATCH(1,--(R1C3:R1C4=RC[-1]),0)))-1)"
    lrow = lrow + 2
Next i
End Sub

Excel更改列值以分隔行

2 个答案: