如何满足多个列的条件汇总

liaozhc

一把小刀闯天下 发表于 2018-6-9 09:01
在end with 上面插入一行：

.Offset(-1).Resize(, 6) = Split("序号 学校名称 姓名 性别 类别 项目")

多谢，那下面的工作表名怎么样自动读取ComboBox1的值呢？

liaozhc

一把小刀闯天下 发表于 2018-6-9 09:01
在end with 上面插入一行：

.Offset(-1).Resize(, 6) = Split("序号 学校名称 姓名 性别 类别 项目")

工作表名怎么样自动读取ComboBox1的值呢，表头单元格怎么样随内容变化而变化呢？真的多谢你

一把小刀闯天下

liaozhc 发表于 2018-6-9 09:15
工作表名怎么样自动读取ComboBox1的值呢，表头单元格怎么样随内容变化而变化呢？真的多谢你

没看懂：
ComboBox1.AddItem "sheet6"

或者
ComboBox1.Text = "sheet6"

但没什么意义，并不知道你想做什么
----------------------------------------
或者输出到当前工作表？

把  With Sheets("sheet6").[a2] 改成：
With ActiveSheet.[a2]

一把小刀闯天下

lsc900707 发表于 2018-6-9 07:01
“多谢”再多，不如直接给别人“评分”：点击对方帖子右下角“评分”按提示操作即可。

还是版主老师理解我，一朵小花精神马上就上来了，哈哈哈。

liaozhc

一把小刀闯天下 发表于 2018-6-9 09:23
没看懂：
ComboBox1.AddItem "sheet6"

多谢，输出到新的工作表，新的工作表名就是筛选的条件

一把小刀闯天下

liaozhc 发表于 2018-6-9 09:56
多谢，输出到新的工作表，新的工作表名就是筛选的条件

“输出到新的工作表“
可以用代码来指定工作表名，不过觉得没有什么意义。自己用的表格没必要这样做。
你可以在代码中把sheet6改成任一存在的工作表名就可以。

“新的工作表名就是筛选的条件”
已经输出到新的工作表了，为什么还把它作为筛选条件呢。你的筛选条件不就是3个combobox中的内容吗？是否启用这3个条件由相对应的checkbox来决定。源数据有了、条件有了于是结果就可以确定了。

或者你想处理不同的工作表中的源数据，你可以这样处理：
data = Sheets("sheet1").UsedRange
把sheet1改成任一存在的工作表名，当然这个表格中的列的数据位置是确定的（按列来定位的，不然结果肯定会出错），行数不限。

liaozhc

一把小刀闯天下 发表于 2018-6-9 10:13
“输出到新的工作表“
可以用代码来指定工作表名，不过觉得没有什么意义。自己用的表格没必要这样做。
...

可能是我没有讲清楚，就是新输出的工作表的名字就是三个条件的文字加在一起的名字，我发一个附件给你参考下

一把小刀闯天下

liaozhc 发表于 2018-6-9 10:57
可能是我没有讲清楚，就是新输出的工作表的名字就是三个条件的文字加在一起的名字，我发一个附件给你参考 ...

'项目3列变1列了，如果是这样直接使用工作表的筛选功能就可以了

Option Explicit

Dim data

Private Sub CommandButton1_Click()
  Dim i, j, k, n, m, cnt, datatemp, sht
  ReDim arr(1 To UBound(data, 1), 5)
  cnt = UBound(data, 1): datatemp = data
  If CheckBox1.Value Then
    For i = 2 To UBound(datatemp, 1)
      If datatemp(i, 5) = ComboBox1.Text Then
        n = n + 1
        For j = 1 To 5: datatemp(n, j) = datatemp(i, j): Next
      End If
    Next
    cnt = n
  End If
  n = 0
  If CheckBox2.Value Then
    For i = 1 To cnt
      If datatemp(i, 4) = ComboBox2.Text Then
        n = n + 1
        For j = 1 To 5: datatemp(n, j) = datatemp(i, j): Next
      End If
    Next
    cnt = n
  End If
  n = 0
  If CheckBox3.Value Then
    For i = 1 To cnt
      If datatemp(i, 3) = ComboBox3.Text Then
        n = n + 1
        For j = 1 To 5: datatemp(n, j) = datatemp(i, j): Next
      End If
    Next
    cnt = n
  End If
  If CheckBox1.Value Or CheckBox2.Value Or CheckBox3.Value Then
    If cnt > 0 Then
      For i = 1 To cnt
        For j = 1 To 5
          arr(i, j) = datatemp(i, j)
      Next j, i
      Call bsort(arr, 1, cnt)
      For i = 1 To cnt: arr(i, 0) = i: Next
      sht = IIf(CheckBox1.Value, ComboBox1.Text, vbNullString) & _
            IIf(CheckBox2.Value, ComboBox2.Text, vbNullString) & _
            IIf(CheckBox3.Value, ComboBox3.Text, vbNullString) & "组"
      n = 0
      For Each i In Sheets
        If i.Name = sht Then n = 1: Exit For
      Next
      If n = 0 Then Sheets.Add: ActiveSheet.Name = sht
    End If
  Else
    cnt = 0
  End If
  If Len(sht) > 0 Then
    With Sheets(sht).[a2]
      .Resize(Rows.Count - 1, UBound(arr, 2) + 1).ClearContents
      If cnt > 0 Then .Resize(cnt, UBound(arr, 2) + 1) = arr
      .Offset(-1).Resize(, 6) = Split("序号 学校名称 姓名 性别 类别 项目")
    End With
  End If
End Sub

Private Sub CommandButton2_Click()
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  Dim i, j, dic(2)
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  data = Sheets("sheet1").UsedRange
  For i = 2 To UBound(data, 1)
    dic(1)(data(i, 4)) = vbNullString
    dic(2)(data(i, 3)) = vbNullString
    dic(0)(data(i, 5)) = vbNullString
  Next
  For Each i In dic(0).keys: ComboBox1.AddItem i: Next: ComboBox1.ListIndex = 0
  For Each i In dic(1).keys: ComboBox2.AddItem i: Next: ComboBox2.ListIndex = 0
  For Each i In dic(2).keys: ComboBox3.AddItem i: Next: ComboBox3.ListIndex = 0
  CheckBox1.Value = 1: CheckBox2.Value = 1: CheckBox3.Value = 1
End Sub

Function bsort(arr, first, last)
  Dim i, j, k, kk, t, move As Boolean
  For i = first To last - 1
    For j = first To last + first - 1 - i
      For k = LBound(arr, 2) To UBound(arr, 2) - 1
        If arr(j, k) > arr(j + 1, k) Then
          For kk = k To UBound(arr, 2)
            t = arr(j, kk): arr(j, kk) = arr(j + 1, kk): arr(j + 1, kk) = t
          Next
          move = True: Exit For
        ElseIf arr(j, k) = arr(j + 1, k) Then
          If arr(j, k + 1) > arr(j + 1, k + 1) Then
            For kk = k + 1 To UBound(arr, 2)
              t = arr(j, kk): arr(j, kk) = arr(j + 1, kk): arr(j + 1, kk) = t
            Next
            move = True
          ElseIf arr(j, k + 1) < arr(j + 1, k + 1) Then
            Exit For
          End If
        Else
          Exit For
        End If
      Next k, j
      If Not move Then Exit For
    Next
End Function

liaozhc

一把小刀闯天下 发表于 2018-6-9 11:26
'项目3列变1列了，如果是这样直接使用工作表的筛选功能就可以了

Option Explicit

多谢，真的多谢，但我可能还是没有讲清楚，这次的vba编程偏离了方向，你第一次的vab已基本接近我所需要的，你的第二次的修正，又更加接近了我的要求，只是新的工作表名，我想是电脑生成的，而不是我将文字打上去的，就是这么一个小小的问题了。

一把小刀闯天下

liaozhc 发表于 2018-6-9 12:43
多谢，真的多谢，但我可能还是没有讲清楚，这次的vba编程偏离了方向，你第一次的vab已基本接近我所需要的 ...

已经给你自动生成输出表格的表名了，根据3个combobox中当前文本有序组合而成(对应的checkbox为true)，试一下就知道了。

如果还有问题我也没招了。