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

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

¥»©«³Ì«á¥Ñ 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 (64.46 KB)

1.PNG

TOP

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

¦^´_ 7# wang077


­Y·Q§ä¸ê®Æ¬[ºcªº¾Ç²ß±Ð§÷¬ÛÃö
½Ð¤Wºô¬d¸ß "¸ê®Æ®w¥¿³W¤Æ" "¸ê®Æ®w­S¦¡" ©ÎªÌ"¸ê®Æ®w¬[ºc" »P "ÃöÁp¦¡¸ê®Æ®w"

test (4).zip (60.28 KB)

TOP

¦^´_ 12# singo1232001
«D±`·PÁ¤j¤j
§Ú·|¥h¬ã¨s¬Ý¬Ýªº¡I

TOP

¥»©«³Ì«á¥Ñ wang077 ©ó 2021-7-29 16:35 ½s¿è

¦^´_ 11# samwang
¤j¤j¡A¦pªG§ÚDÄæ¥u­n¤J®w¡B¨}«~¡B¨}²v©O¡A¥BDÄæ¥i­«½ÆÅã¥Ü

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 (47.47 KB)

2.PNG

TOP

¦^´_ 15# samwang
¤j¤j¡A§Ú¦³±HÀɮרì§Aªºgmail
¥i¥H³Â·Ð§A¬Ý¤@¤U¶Ü¡AÁÂÁÂ

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

¦^´_ 18# samwang
·PÁ¤j¤jÀ°¦£¡A§Ú¦³¦^«H¨ì§Aªºmail³á¡I

TOP

¸Ü»¡³oºØªí³æ¬d¸ß¦³¦ó°µ¥Î???
­Y¬O¦]¬°ªí®æ¾î¼e¤ÎÁaªø¤Ó¤j, ·Q½Õ¥X«ü©w¸ê®Æ°µ­×§ï,
¨ºÁÙ¬O¦b­ìªí¾Þ§@¸û¹ê¦b~~

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD