GBKEE

回復 28# owen9399

1. Private Sub CommandButton3_Click() '查詢
   
2.     Dim I As Integer, Rng As Range
   
3.      With Sh(2)
   
4.          .AutoFilterMode = False
   
5.          For I = 1 To UBound(ar)
   
6.             If ar(I) <> "" Then .Range("A1").AutoFilter I, ar(I)
   
7.          Next
   
8.         '.Range("A:i").SpecialCells(xlCellTypeVisible).Copy .Range("AA1") ->'Sh(2)的 AA1->AI欗
   
9.          '*******   .ColumnCount = 8    'ListBox1設定8欗     所以改成如下********
   
10.         .Range("A:H").SpecialCells(xlCellTypeVisible).Copy .Range("AA1")
    
11.          .AutoFilterMode = False
    
12.          Set Rng = .Range("AA1").CurrentRegion.Offset(1)   'Sh(2)的 AA1->AH :AI欗的資料,*****AI欗須先刪掉(手動)*****
    
13.      End With
    
14.   ListBox1.RowSource = Rng.Address
    
15. End Sub
    
16. Private Sub CommandButton4_Click() '刪除整列
    
17.     Dim s, E As Range, I As Integer
    
18.     With ListBox1
    
19.         If .ListIndex = -1 Then MsgBox "沒有選擇!!": Exit Sub
    
20.         s = Application.Index(Application.Transpose(Application.Transpose(.List)), IIf(.ListCount = 1, 0, 1))
    
21.         If Join(s, "") = "" Then MsgBox "沒有資料!!": Exit Sub
    
22.         s = Application.Index(Application.Transpose(Application.Transpose(.List)), IIf(.ListCount = 1, 0, .ListIndex + 1))
    
23.         'S= ListIndex的選擇.ListIndex 那一列的資料,會比 Resize(, 8)多一欗.
    
24.         '當
    
25.         '->.Range("A:i").SpecialCells(xlCellTypeVisible).Copy .Range("AA1") ->'Sh(2)的 AA1->AI欗
    
26.         '-> For Each E In .Range("A1", .Range("A1").End(xlDown)).Resize(, 8).Rows '整列:[ 自動編號......業務員 ]
    
27.     End With
    
28.     s = Join(s, ",")   'S:  結合控制項的字串 [ 自動編號序號公司配額筆數數值應付已付(進貨數量1+進貨數量2)業務員 ]
    
29.     With Sh(2)
    
30.          For Each E In .Range("A1", .Range("A1").End(xlDown)).Resize(, 8).Rows '整列:[ 自動編號......業務員 ]
    
31.             Debug.Print s
    
32.             Debug.Print Join(Application.Transpose(Application.Transpose(E)), ",")
    
33.             If s = Join(Application.Transpose(Application.Transpose(E)), ",") Then
    
34.                
    
35.                 If MsgBox(Join(Application.Transpose(Application.Transpose(E.Value)), ","), vbYesNo, "刪除列") = vbYes Then
    
36.                      處裡刪除整列 E
    
37.                 End If
    
38.             End If
    
39.         Next
    
40.     End With
    
41.     CommandButton3_Click   '重新查詢
    
42. End Sub

複製代碼

GBKEE

回復 30# owen9399
請在對照 29# 看看我說了什麼!

1. Private Sub CommandButton3_Click() 'UserForm2的查詢程式碼
   
2. Dim I As Integer, Rng As Range
   
3.      With Sh(2)
   
4.           .Range("AA1").CurrentRegion = ""  '加這行 UserForm2表單執行一次後可不需這程式碼
   
5.          .AutoFilterMode = False
   
6.          For I = 1 To UBound(ar)
   
7.             If ar(I) <> "" Then .Range("A1").AutoFilter I, ar(I)
   
8.          Next
   
9.         .Range("A:h").SpecialCells(xlCellTypeVisible).Copy .Range("AA1")
   
10. '原本是 .Range("A:i").SpecialCells(xlCellTypeVisible).Copy .Range("AA1")
    
11.          .AutoFilterMode = False
    
12.          Set Rng = .Range("AA1").CurrentRegion.Offset(1)
    
13.      End With
    
14.   ListBox1.RowSource = Rng.Address
    
15. End Sub

複製代碼

GBKEE

回復 32# owen9399
選擇進貨表中的資料範圍,用指令[資料]-> [自動篩選],將各業務員依次的篩選資料,複製到各業務員的工作表裡
自己試試,用錄製巨集,看看程式碼,練習一下,

GBKEE

回復 34# owen9399
進步好多,讚.

1. Private Sub CommandButton3_Click()
   
2.     Dim y
   
3.     Dim Joken3 As String
   
4.     Joken3 = "小王"
   
5.     If Joken3 = "" Then Exit Sub
   
6.     With Sheets("進貨表")
   
7.         '若在篩選中，先解除顯示全部
   
8.         If .FilterMode Then .ShowAllData
   
9.         '以〔第5欄．業務員〕進行篩選
   
10.         .[A1].AutoFilter Field:=5, Criteria1:=Joken3
    
11.         '取得篩選後，最後一筆資料的〔列號〕
    
12.         y = .[A65536].End(xlUp).Row
    
13.         '進行貼轉資料
    
14.         .Range("A1:F" & y).Copy [小王總庫存!A1]
    
15.         '再恢復全表
    
16.         .ShowAllData
    
17.         '取消[自動篩選] 下拉箭號
    
18.         .[A1].AutoFilter
    
19.         MsgBox [SUM(小王總庫存!F:F)]  '篩選後的加總
    
20.   End With
    
21.   Beep
    
22. End Sub

複製代碼

GBKEE

回復 38# owen9399
[阿美總庫存] 模組預設事件程序之程式碼

1. Option Explicit
   
2. Private Sub Worksheet_Activate()          '活頁簿: 選擇工作表的預設事件
   
3.     '進階篩選  公司名稱  'Columns.Count ->工作表的總欗數 ->最後一欗
   
4.     Range("B:B").AdvancedFilter xlFilterCopy, , Cells(1, Columns.Count), True
   
5.     With Range("I2").Validation   '資料的驗證清單
   
6.         .Delete
   
7.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
   
8.         xlBetween, Formula1:="=" & Range(Cells(2, Columns.Count).Address, Cells(1, Columns.Count).End(xlDown).Address).Address
   
9.         .IgnoreBlank = True
   
10.       
    
11.     End With
    
12. End Sub
    
13. Private Sub Worksheet_Change(ByVal Target As Range)
    
14.     Application.EnableEvents = False
    
15.     If Target.Address(0, 0) = "I2" Then
    
16.         Range("J2") = [SUMIF(B:B,I2,D:D)]   '工作表的函數在 VBA用中括號計算  [ <- 工作表的函數  -> ]
    
17.         Range("K2") = [SUMIF(B:B,I2,F:F)]
    
18.     End If
    
19.     Application.EnableEvents = True
    
20. End Sub

複製代碼

GBKEE

回復 41# owen9399
程式碼更新後,請檔案關閉,再開啟.

GBKEE

回復 44# owen9399

1. Private Function 資料檢查() As Boolean
   
2.     Dim s As String, E As Range, I As Integer, ii
   
3.     With Sh
   
4.         For I = 2 To UBound(ar)
   
5.             ii = 10 - Len(Sh.Cells(1, I))
   
6.             If I = 2 Or I = 3 Or I = 6 Then
   
7.                If ar(I).ListIndex = -1 Then s = s & IIf(s = "", "", vbLf) & Sh.Cells(1, I) + Space(ii) & vbTab & ar(I)
   
8.             Else
   
9.                 If Not IsNumeric(ar(I)) And ar(I) <> "" Then s = s & IIf(s = "", "", vbLf) & Sh.Cells(1, I) + Space(ii) & vbTab & ar(I)
   
10. 
    
11.             End If
    
12.         Next
    
13.         If s <> "" Then
    
14.             資料檢查 = True: MsgBox s, , "資料有誤!!": Exit Function
    
15.         ElseIf s = "" And ar(4) & ar(5) & ar(7) & ar(8) = "" Then
    
16.             資料檢查 = True: MsgBox "出貨 進貨 沒有數量", , "資料有誤!!": Exit Function
    
17.         End If
    
18.         '******** 以下為檢查是否有相同的資料 如不需要可刪除  ****************
    
19.         s = "," & Join(ar, "")
    
20.         s = Replace(s, "," & ar(1), "")  'S:  結合控制項的字串 [ 序號公司產品名稱台北出貨1台北出貨2業務員進貨數量1進貨數量2 ]
    
21.         For Each E In .Range("B1", .Range("B1").End(xlDown)).Resize(, 7).Rows
    
22.             If s = Join(Application.Transpose(Application.Transpose(E.Value)), "") Then
    
23.                 MsgBox Replace(Join(ar, ","), ar(1) & ",", "") & vbLf & "已存在為 第" & E.Row - 1 & " 筆 資料不可新增"
    
24.                 資料檢查 = True
    
25.                 Exit Function
    
26.             End If
    
27.         Next
    
28.         '******************************************************************************
    
29.         End With
    
30.   End Function

複製代碼

GBKEE

回復 46# owen9399
附上檔案看看