Question

首先，提前感谢您的回答。我正在使用Excel工作表和vba，我遇到了问题。

我有这些数据（表1）：

REFERENCE     COUNTRIES   ORIGIN   DISTRIBUTED
2014.AOK      Iran          1          0
2014.AOK      Bulgaria      0          1
2014.AOK      Spain         0          1

我想创建一个新表格，其信息结构如下（表2）：

REFERENCE    ORIGIN   DISTRIBUTED
2014.AOK      Iran    Bulgaria, Spain

正如您在表1中看到的，3行的参考相同。每行都有不同的国家/地区。我的目标是将所有信息写入一行，具体取决于＆＃34; DISTRIBUTED＆＃34;。

如果某个国家/地区的DISTRIBUTED列中有1，则应在该列中包含1的最后一列之后添加。在此示例中，保加利亚和西班牙应该在同一列中，用逗号分隔。

我曾尝试使用vba执行此操作，但我不知道该怎么做。你能给我一个线索吗？

非常非常感谢!!

Answer 1

这应该有用它没有，但它应该。可能会帮助别人。

Sub ert()
e = NamesArrayFiltered(Range("B:B"), Range("D:D"), 1, Range("A:A"), "2014.AOK")
MsgBox e
End Sub

＆＃39;

Public Function NamesArrayFiltered(myNames As Range, Optional Filter1 As Range, Optional FilterCriterion1 As Variant, _
                                   Optional Filter2 As Range, Optional FilterCriterion2 As Variant) As String
NamesArrayFiltered = ""
Dim FilterFound(1 To 2) As Boolean
    FilterFound(1) = Not Filter1 Is Nothing
        If FilterFound(1) Then FilterFound(1) = Not Filter1 Is Nothing
    FilterFound(2) = Not Filter2 Is Nothing
        If FilterFound(2) Then FilterFound(2) = Not Filter2 Is Nothing
Set Filter1 = Intersect(Filter1, Filter1.Worksheet.UsedRange)
Set myNames = Intersect(myNames, myNames.Worksheet.UsedRange)
Set Filter2 = Intersect(Filter1, Filter1.Worksheet.UsedRange)

Dim RowsCount As Long, ColumnsCount As Long, CellsCount As Long
RowsCount = Filter1.Rows.Count
ColumnsCount = Filter1.Columns.Count
CellsCount = Filter1.Cells.Count
Dim NamesArray() As Variant, Counter1 As Long
ReDim NamesArray(1 To CellsCount)
Counter1 = 1

On Error Resume Next
For i = 1 To RowsCount
    For j = 1 To ColumnsCount
        If FilterFound(1) Then
            If Filter1(i, j).Value2 = FilterCriterion1 Then
                If FilterFound(2) Then
                    If Filter2(i, j).Value2 = FilterCriterion2 Then
                        NamesArray(Counter1) = myNames(i, j).Value2
                        Counter1 = Counter1 + 1
                    End If
                Else
                    NamesArray(Counter1) = myNames(i, j).Value2
                    Counter1 = Counter1 + 1
                End If
            End If
        End If
            'If (Filter1(i, j).Value2 = FilterCriterion1 And FilterFound(1)) And (Filter1(i, j).Value2 = FilterCriterion1 And FilterFound(1)) Then
            '    NamesArray(Counter1) = myNames(i, j).Value2
            '    Counter1 = Counter1 + 1
            'End If
    Next j
Next i
NamesArrayFiltered = Join(NamesArray(), ", ")
NamesArrayFiltered = Left(NamesArrayFiltered, InStr(NamesArrayFiltered, ", , ") - 1)
End Function

Excel VBA过滤和分组行vba

1 个答案: