时间戳

首页 > 解决方案 > 没有为 If/Else 语句 + 连接产生预期结果

excel - 没有为 If/Else 语句 + 连接产生预期结果

问题描述

我正在使用 3 个不同的表（工作表），它们都在同一个工作簿中。第一个工作表称为“转化事件”，它包含转化事件和日期。“Conv Event”中的数据如下所示：

转化事件表

第二个工作表称为“生态事件”，它包含名称和转换事件。“生态事件”中的数据如下所示：

生态活动表

第三个工作表称为“APM MASTER”，它包含名称和 EC 事件。名称在 G 列中，EC 事件在此工作表的 H 列中。

我试图用下面的代码完成的是 1）在“Eco Event”表中查找与“APM Master”表中的名称匹配/具有相同名称的名称
2）从这些匹配项（即，您在“APM Master”表和“Eco Event”表中具有相同名称）在“Eco Event”表中，并将事件与“Conv Event”表中的相同事件匹配 3）连接将“Conv Event”表中的转换事件和日期放入“APM Master”表的 H 列，其中“APM Master”表中 G 列中的名称与“Eco Event”表中 A 列中的名称匹配。

APM Master 表应如下所示：

APM 主表结果

代码运行时没有错误，但是，当我运行它时，“APM Master”工作表的 H 列中没有显示任何内容。有人可以帮我弄清楚为什么代码没有产生预期的结果，只是空白单元格吗？

Sub EarlyConversion()

With Worksheets("APM MASTER")

Dim i As Long
Dim LastRow As Long
Dim rng1 As Range
Dim rng2 As Range
Dim ws As Worksheet

Set rng1 = Worksheets("Eco Event").Range("A2:A387")
Set rng2 = Worksheets("Eco Event").Range("B2:B387")
Set ws = Worksheets("Conv Event")
LastRow = .Range("H" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A6")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A7")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A8")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A9")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A10")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A11")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A12")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A13")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A14")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A15")) > 0 Then

      .Range("H" & i) = ws.Range("A6").Value & ": " & 
        ws.Range("B6") & ", " & ws.Range("A7").Value & ": " & 
        ws.Range("B7") & ", " & ws.Range("A8").Value & ": " & 
        ws.Range("B8") & ", " & ws.Range("A9").Value & ": " & 
        ws.Range("B9") & ", " & ws.Range("A10").Value & ": " & 
        ws.Range("B10") & ", " & ws.Range("A11").Value & ": " & 
        ws.Range("B11") & ", " & ws.Range("A12").Value & ": " & 
        ws.Range("B12") & ", " & ws.Range("A13").Value & ": " & 
        ws.Range("B13") & ", " & ws.Range("A14").Value & ": " & 
        ws.Range("B14") & ", " & ws.Range("A15").Value & ": " & 
        ws.Range("B15")

    ElseIf Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A6")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A7")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A8")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A9")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A10")) > 0 And
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A11")) > 0 And   
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A12")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A13")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A14")) > 0 Then

      .Range("H" & i) = ws.Range("A6").Value & ": " & 
        ws.Range("B6") & ", " & ws.Range("A7").Value & ": " & 
        ws.Range("B7") & ", " & ws.Range("A8").Value & ": " & 
        ws.Range("B8") & ", " & ws.Range("A9").Value & ": " & 
        ws.Range("B9") & ", " & ws.Range("A10").Value & ": " & 
        ws.Range("B10") & ", " & ws.Range("A11").Value & ": " & 
        ws.Range("B11") & ", " & ws.Range("A12").Value & ": " & 
        ws.Range("B12") & ", " & ws.Range("A13").Value & ": " & 
        ws.Range("B13") & ", " & ws.Range("A14").Value & ": " & 
        ws.Range("B14")

    ElseIf Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A6")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A7")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A8")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A9")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A10")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A11")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A12")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A13")) > 0 Then

      .Range("H" & i) = ws.Range("A6").Value & ": " & 
        ws.Range("B6") & ", " & ws.Range("A7").Value & ": " & 
        ws.Range("B7") & ", " & ws.Range("A8").Value & ": " & 
        ws.Range("B8") & ", " & ws.Range("A9").Value & ": " & 
        ws.Range("B9") & ", " & ws.Range("A10").Value & ": " & 
        ws.Range("B10") & ", " & ws.Range("A11").Value & ": " & 
        ws.Range("B11") & ", " & ws.Range("A12").Value & ": " & 
        ws.Range("B12") & ", " & ws.Range("A13").Value & ": " & 
        ws.Range("B13")

    ElseIf Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A6")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A7")) > 0 And 
    Application.CountIfs(rng1, 
    Worksheets("APM MASTER").Range("G" & i), rng2, 
    ws.Range("A8")) > 0 Then

      .Range("H" & i) = ws.Range("A6").Value & ": " & 
        ws.Range("B6") & ", " & ws.Range("A7").Value & ": " & 
        ws.Range("B7") & ", " & ws.Range("A8").Value & ": " & 
        ws.Range("B8")
... 

End If
Next i

End With
End Sub

标签： excelvba

解决方案

不寻常的数据转换

  • 它的不寻常之处在于它依赖于标题和工作表名称，而不是像通常那样依赖于行和列。因此，在您使用它之前，请仔细检查所有前 9 个常量。它们必须与您的工作簿中的相同，否则程序将失败。当然，这些词（用于标题）中的任何一个都不能单独使用在实际标题之前（上面的行和前面的同一行）的单元格中。
  • 根据需要更改分隔符的第 10 个和第 11 个常量。
  • 所有 4 个程序都必须复制到一个标准module（例如Module1）。您运行的第一个过程是 asub调用（使用）其他 3 functions。
  • 我以这种方式编写代码是因为您以如此罕见的精确度提出了您的问题，以至于我无法抗拒。我希望你会发现它有用。

编码

Option Explicit

Sub test()
    ' Constants
    Const SheetCE As String = "Conv Event"
    Const SheetEE As String = "Eco Event"
    Const SheetAM As String = "APM Master"
    Const hCE1 As String = "Conversion Event"
    Const hCE2 As String = "Date"
    Const hEE1 As String = "Name"
    Const hEE2 As String = "Conversion Event"
    Const NameHeader As String = "Name"
    Const EventsHeader As String = "EC Events"
    Const NameSeparator As String = ": "
    Const EventSeparator As String = ", "
    'Other Variables
    Dim wsCE As Worksheet, wsEE As Worksheet, wsAM As Worksheet, rng As Range
    Dim CE_Event, CE_Date, EE_Name, EE_Event, AM_Name, AM_Events
    Dim CurrName As String, CurrEvent As String, CurrResult As String
    Dim i As Long, j As Long, k As Long
    ' Define worksheets.
    Set wsCE = ThisWorkbook.Worksheets(SheetCE)
    Set wsEE = ThisWorkbook.Worksheets(SheetEE)
    Set wsAM = ThisWorkbook.Worksheets(SheetAM)
    ' Write Source Columns to Source Arrays.
    CE_Event = getColumnBelowHeader(wsCE, hCE1)
    CE_Date = getColumnBelowHeader(wsCE, hCE2)
    EE_Name = getColumnBelowHeader(wsEE, hEE1)
    EE_Event = getColumnBelowHeader(wsEE, hEE2)
    ' Write from Source Arrays to Target Array.
    AM_Name = getUniqueColumn(EE_Name)
    ReDim AM_Events(1 To UBound(AM_Name), 1 To 1)
    For i = 1 To UBound(AM_Name)
        CurrName = AM_Name(i, 1)
        For j = 1 To UBound(EE_Name)
            If EE_Name(j, 1) = CurrName Then
                CurrEvent = EE_Event(j, 1)
                If Not IsError(Application.Match(CurrEvent, CE_Event, 0)) Then
                    GoSub writeAM_Events
                Else
                    MsgBox CurrEvent & " not found."
                End If
            End If
        Next j
    Next i
    ' Write to Target Worksheet.
    Set rng = getHeaderCell(wsAM, NameHeader)
    If Not rng Is Nothing Then _
      rng.Offset(1).Resize(UBound(AM_Name)) = AM_Name
    Set rng = getHeaderCell(wsAM, EventsHeader)
    If Not rng Is Nothing Then _
      rng.Offset(1).Resize(UBound(AM_Events)) = AM_Events
    ' Inform user.
    MsgBox "Operation finshed successfully.", vbInformation
    ' Debug.print
    For i = 1 To UBound(AM_Name)
        Debug.Print AM_Name(i, 1), AM_Events(i, 1)
    Next i

GoTo exitProcedure

writeAM_Events:
    k = Application.Match(CurrEvent, CE_Event, 0)
    CurrResult = CE_Event(k, 1) & NameSeparator & CE_Date(k, 1)
    If AM_Events(i, 1) <> "" Then _
      CurrResult = AM_Events(i, 1) & EventSeparator & CurrResult
    AM_Events(i, 1) = CurrResult
Return

exitProcedure:

End Sub

' Writes the values of the non-empty column range below the first found
' specified string to a 2D one-based one-column array.
Function getColumnBelowHeader(Sheet As Worksheet, Header As String) As Variant
    Dim rng As Range, FirstCell As Range, LastCell As Range
    Set rng = getHeaderCell(Sheet, Header)
    With Sheet
        Set rng = .Cells.Find(What:=Header, _
          After:=.Cells(.Rows.Count, .Columns.Count), _
          LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
        If rng Is Nothing Then GoTo exitError
        If rng.Row = .Rows.Count Then GoTo exitError
        Set FirstCell = rng.Offset(1)
        Set rng = .Range(FirstCell, .Cells(.Rows.Count, FirstCell.Column))
        Set LastCell = rng.Find(What:="*", _
          LookIn:=xlFormulas, SearchDirection:=xlPrevious)
        If LastCell Is Nothing Then GoTo exitError
        getColumnBelowHeader = .Range(FirstCell, LastCell)
    End With
GoTo exitProcedure
exitError:
    getColumnBelowHeader = Array()
exitProcedure:
End Function

' Returns the first cell range where a specified string was found.
Function getHeaderCell(Sheet As Worksheet, Header As String) As Range
    Dim rng As Range
    With Sheet
        Set getHeaderCell = Sheet.Cells.Find(What:=Header, _
          After:=Sheet.Cells(.Rows.Count, .Columns.Count), _
          LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
    End With
End Function

' Creates a 2D one-based one-column array with unique values of another
' 2D one-base one-column array (usually data from column in worksheet).
Function getUniqueColumn(ColumnArray As Variant) As Variant
    Dim dict As Object, Key As Variant, TargetArray As Variant, i As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ColumnArray)
        If Not IsMissing(ColumnArray(i, 1)) Then
            dict(ColumnArray(i, 1)) = Empty
        End If
    Next i
    ReDim TargetArray(1 To dict.Count, 1 To 1): i = 1
    For Each Key In dict.Keys
        TargetArray(i, 1) = Key
        i = i + 1
    Next Key
    getUniqueColumn = TargetArray
End Function

推荐阅读