ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] °õ¦æ¶¥¬q¿ù»~'380'

¥»©«³Ì«á¥Ñ samwang ©ó 2021-7-29 13:04 ½s¿è

¦^´_ 1# wang077

¬O³o¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Private Sub ComboBox2_Change()
Range("$A$2:$AJ$65536").AutoFilter Field:=1, Criteria1:=ComboBox2.Text
End Sub

Private Sub CommandButton3_Click()
Dim Arr, Ar(), i&, j&
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2))
    For j = 1 To UBound(Arr, 2)
        For i = 1 To UBound(Arr)
            If Arr(i, j) <> "" Then
            If j <> j1 Then j1 = j: n = n + 1
            If Ar(1, n) = "" Then Ar(1, n) = Cells(2, j)
            Ar(i + 1, n) = Arr(i, j)
            End If
        Next
    Next
    With Me.ListBox1
      .List = Ar
      .ColumnCount = n
    End With
End If
Sheets(b).Select
End Sub

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-7-29 15:12 ½s¿è

¦^´_ 8# wang077

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2))
    For j = 1 To UBound(Arr, 2)
        If j > 4 And j < 36 Then GoTo 99
        For i = 1 To UBound(Arr)
            If Arr(i, j) <> "" Then
                If xD(Arr(i, j)) <> 1 Then
                    xD(Arr(i, j)) = 1
                    If j <> j1 Then j1 = j: n = n + 1
                    If Ar(1, n) = "" Then Ar(1, n) = Cells(2, j)
                    If j = 36 And i = UBound(Arr) Then
                        Ar(i + 1, n) = Format(Arr(i, j), "0%")
                    Else
                        Ar(i + 1, n) = Arr(i, j)
                    End If
                End If
            End If
        Next
99: Next
    With Me.ListBox1
      .List = Ar
      .ColumnCount = n
    End With
End If
Sheets(b).Select
End Sub
1.PNG

TOP

¦^´_ 14# wang077

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2))
    For j = 1 To UBound(Arr, 2)
        If j > 4 And j < 36 Then GoTo 99
        For i = 1 To UBound(Arr)
            If j > 3 Then
                If Arr(i, j) = "¤£¨}" Then i1 = i: GoTo 98
                If Arr(i, j) = "³ø¼o" Then i2 = i: GoTo 98
                If i1 = i Or i2 = i Then GoTo 98
            End If
            If Arr(i, j) <> "" Then
                If xD(Arr(i, j)) <> 1 Then
                   If j < 35 Then xD(Arr(i, j)) = 1
                    If j <> j1 Then j1 = j: n = n + 1: m = 2
                    Ar(1, n) = Cells(2, j)
                    If j = 36 And i = UBound(Arr) Then
                        Ar(m, n) = Format(Arr(i, j), "0%")
                    Else
                        Ar(m, n) = Arr(i, j): m = m + 1
                    End If
                End If
            End If
98:   Next
99: Next
    With Me.ListBox1
       .ColumnWidths = "30,30,30,40,40"
      .List = Ar
      .ColumnCount = n
    End With
End If
Sheets(b).Select
End Sub
2.PNG

TOP

¦^´_ 16# wang077

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr), 1 To 4): m = 1
    For i = 1 To UBound(Arr)
        T = Arr(i, 1) & Arr(i, 2) & Arr(i, 4)
        If InStr(T, "´£À˼Æ") Or InStr(T, "¨}«~¼Æ") Or InStr(T, "¨}²v") Then
            If xD(T & "/3") <> 1 Then
                xD(T & "/3") = 1: m = m + 1
                If Ar(1, 1) = "" Then '²Ä1¦C
                    Ar(1, 1) = Cells(2, 1): Ar(1, 2) = Cells(2, 2)
                    Ar(1, 3) = Cells(2, 4): Ar(1, 4) = Cells(2, 36)
                End If
                If xD(Arr(i, 1) & "/1") <> 1 Then xD(Arr(i, 1) & "/1") = 1: Ar(m, 1) = Arr(i, 1)
                If xD(Arr(i, 2) & "/2") <> 1 Then xD(Arr(i, 2) & "/2") = 1: Ar(m, 2) = Arr(i, 2)
                Ar(m, 3) = Arr(i, 4)
                If InStr(T, "¨}²v") Then Ar(m, 4) = Format(Arr(i, 36), "0%") Else Ar(m, 4) = Arr(i, 36)
            End If
        End If
    Next
   
    With Me.ListBox1
      .ColumnWidths = "40,50,70,40"
      .List = Ar
      .ColumnCount = m
    End With
End If
Sheets(b).Select
End Sub

TOP

¦^´_ 16# wang077


¤£¦n·N«ä¡A§ó·s17¼Óµ{¦¡¡A±N²Ä1¦C²¾¨ì°j°é¥~¡AÁÂÁÂ
   
Private Sub CommandButton3_Click()
Dim Arr, Ar(), xD, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
b = ComboBox1.Text
Sheets(b).Select
If Me.ComboBox2.Text <> "" And Me.ComboBox3.Text = "" Then
    Arr = Sheets(b).AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    ReDim Ar(1 To UBound(Arr), 1 To 4): m = 1
    Ar(1, 1) = Cells(2, 1): Ar(1, 2) = Cells(2, 2)  '²Ä¤@¦C
    Ar(1, 3) = Cells(2, 4): Ar(1, 4) = Cells(2, 36)

   
    For i = 1 To UBound(Arr)
        T = Arr(i, 1) & Arr(i, 2) & Arr(i, 4)
        If InStr(T, "´£À˼Æ") Or InStr(T, "¨}«~¼Æ") Or InStr(T, "¨}²v") Then
            If xD(T & "/3") <> 1 Then
                xD(T & "/3") = 1: m = m + 1
                If xD(Arr(i, 1) & "/1") <> 1 Then xD(Arr(i, 1) & "/1") = 1: Ar(m, 1) = Arr(i, 1)
                If xD(Arr(i, 2) & "/2") <> 1 Then xD(Arr(i, 2) & "/2") = 1: Ar(m, 2) = Arr(i, 2)
                Ar(m, 3) = Arr(i, 4)
                If InStr(T, "¨}²v") Then Ar(m, 4) = Format(Arr(i, 36), "0%") Else Ar(m, 4) = Arr(i, 36)
            End If
        End If
    Next
   
    With Me.ListBox1
      .ColumnWidths = "40,50,70,40"
      .List = Ar
      .ColumnCount = m
    End With
End If
Sheets(b).Select
End Sub

TOP

        ÀR«ä¦Û¦b : ¥@¤W¦³¨â¥ó¨Æ¤£¯àµ¥¡G¤@¡B§µ¶¶ ¤G¡B¦æµ½¡C
ªð¦^¦Cªí ¤W¤@¥DÃD