- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
22#
發表於 2013-9-11 10:52
| 只看該作者
回復 21# owen9399 - Option Explicit
- Option Base 1
- Dim Ar(), Sh As Worksheet
- Private Sub CommandButton1_Click()
- Dim Nrow As Integer
- If 資料檢查 = True Then Exit Sub
- Nrow = 資料數
- If MsgBox("確定新增第 " & Nrow & " 資料", vbYesNo) = vbNo Then Exit Sub
-
- Ar(1).Value = Nrow
- With Sh.Range("a" & Ar(1) + 1)
- .Resize(, UBound(Ar)) = Ar
- .Resize(, UBound(Ar)) = .Resize(, UBound(Ar)).Value
- '.Cells(1, "i") = "=sum(r2c4:rc4)+sum(r2c5:rc5)-(sum(r2c7:rc7)+sum(r2c8:rc8))" '庫存差額
- '(台北出貨1 + 台北出貨2) - 業務員的 (進貨數量1+進貨數量2) = 庫存差額 ** 怪怪的 **
- '***************************************************************************************
- ' 庫存差額 : 應該是業務員的 (進貨數量1+進貨數量2) - (台北出貨1 + 台北出貨2)
- .Cells(1, "i") = "=sum(r2c7:rc7)+sum(r2c8:rc8)-(sum(r2c4:rc4)+sum(r2c5:rc5))" '庫存差額
- '***************************************************************************************
- .Cells(1, "i").Value = .Cells(1, "i") '轉化公式 = 計算後的數值
- End With
- End Sub
- Private Sub CommandButton2_Click()
- Dim I As Integer
- For I = 1 To UBound(Ar)
- Ar(I).Value = ""
- Next
- End Sub
- Private Sub CommandButton3_Click()
- Dim I As Integer, Rng As Range
- With Sh
- .AutoFilterMode = False
- For I = 1 To UBound(Ar)
- If Ar(I) <> "" Then .Range("A1").AutoFilter I, Ar(I)
- Next
- .Range("A:i").SpecialCells(xlCellTypeVisible).Copy .Range("AA1")
- .AutoFilterMode = False
- Set Rng = .Range("AA1").CurrentRegion.Offset(1)
- End With
- ListBox1.RowSource = Rng.Address
- End Sub
- Private Sub CommandButton4_Click()
- Dim s, E As Range, I As Integer
- With ListBox1
- If .ListIndex = -1 Then MsgBox "沒有選擇!!": Exit Sub
- s = Application.Index(Application.Transpose(Application.Transpose(.List)), IIf(.ListCount = 1, 0, 1))
- If Join(s, "") = "" Then MsgBox "沒有資料!!": Exit Sub
- s = Application.Index(Application.Transpose(Application.Transpose(.List)), IIf(.ListCount = 1, 0, .ListIndex + 1))
- End With
- s = Join(s, ",") 'S: 結合控制項的字串 [ 自動編號序號公司產品名稱台北出貨1台北出貨2業務員進貨數量1進貨數量2庫存差額 ]
- With Sh
- For Each E In .Range("A1", .Range("A1").End(xlDown)).Resize(, 9).Rows '整列:[ 自動編號......庫存差額 ]
- If s = Join(Application.Transpose(Application.Transpose(E)), ",") Then
- If MsgBox(Join(Application.Transpose(Application.Transpose(E.Value)), ","), vbYesNo, "刪除列") = vbYes Then
- 處裡刪除整列 E
- End If
- End If
- Next
- End With
- CommandButton3_Click '重新查詢
- End Sub
- Private Sub CommandButton5_Click()
- End
- End Sub
- Private Sub UserForm_Initialize()
- Ar = Array(TextBox1, ComboBox1, ComboBox2, TextBox2, TextBox3, ComboBox3, TextBox4, TextBox5)
- Set Sh = Worksheets("sheet1")
- With Sh
- ComboBox1.RowSource = Sh.Range("L2:L5").Address
- ComboBox2.RowSource = Sh.Range("N2:N6").Address
- ComboBox3.RowSource = Sh.Range("M2:M4").Address
- End With
- With ListBox1
- .ColumnHeads = True
- .ColumnCount = 9
- End With
- End Sub
- Private Sub 處裡刪除整列(Rng As Range)
- Dim I As Integer
- Rng.Delete xlUp
- I = 資料數
- If I > 1 Then
- With Sh
- With .Range("a2:a" & I)
- .Value = "=row()-1"
- .Value = .Value
- End With
- With .Range("i2:i" & I)
- .Value = "=sum(r2c7:rc7)+sum(r2c8:rc8)-(sum(r2c4:rc4)+sum(r2c5:rc5))" '庫存差額
- .Value = .Value
- End With
- End With
- End If
-
- End Sub
- Private Function 資料數() As Integer
- 資料數 = Application.CountA(Sh.Range("A:A")) '自動編號
- End Function
- Private Function 資料檢查() As Boolean
- Dim s As String, E As Range, I As Integer, ii
- With Sh
- For I = 2 To UBound(Ar)
- ii = 10 - Len(Sh.Cells(1, I))
- If I = 2 Or I = 3 Or I = 6 Then
- If Ar(I).ListIndex = -1 Then s = s & IIf(s = "", "", vbLf) & Sh.Cells(1, I) + Space(ii) & vbTab & Ar(I)
- Else
- If Not IsNumeric(Ar(I)) And Ar(I) <> "" Then s = s & IIf(s = "", "", vbLf) & Sh.Cells(1, I) + Space(ii) & vbTab & Ar(I)
-
- End If
- Next
- If s <> "" Then
- 資料檢查 = True: MsgBox s, , "資料有誤!!": Exit Function
- ElseIf s = "" And Ar(4) & Ar(5) & Ar(7) & Ar(8) = "" Then
- 資料檢查 = True: MsgBox "出貨 進貨 沒有數量", , "資料有誤!!": Exit Function
- End If
- s = "," & Join(Ar, "")
- s = Replace(s, "," & Ar(1), "") 'S: 結合控制項的字串 [ 序號公司產品名稱台北出貨1台北出貨2業務員進貨數量1進貨數量2 ]
- For Each E In .Range("B1", .Range("B1").End(xlDown)).Resize(, 7).Rows
- If s = Join(Application.Transpose(Application.Transpose(E.Value)), "") Then
- MsgBox Replace(Join(Ar, ","), Ar(1) & ",", "") & vbLf & "已存在為 第" & E.Row - 1 & " 筆 資料不可新增"
- 資料檢查 = True
- Exit Function
- End If
- Next
- End With
- End Function
|
|
發表於 2013-9-11 09:27
| 
