- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
13#
發表於 2012-1-1 09:31
| 只看該作者
本帖最後由 GBKEE 於 2012-1-1 09:39 編輯
回復 10# fyo00241
簡化 UserForm1- Private Sub ComboBox2_Change()
- If ComboBox2 <> "" Then Sheets(ComboBox2.Text).Select '將工作表移到 ComboBox2
- End Sub
- Private Sub cmdOK_Click()
- Dim Msg As String, t, s, 序號, 品名
- '序號 ,品名 也可key好置於工作表 用於搜尋對照
- 序號 = Array(201106, 201101, 201111, 201102, 201103, 201127, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118, 1119, 1120)
-
- 品名 = Array("手打鐘Ⅰ", "手打鐘", "手打鐘Ⅱ", "手打鐘", "手打鐘", _
- "T27印表機", "中文鴿鐘", "英文鴿鐘", "中文語音鴿鐘", "英文語音鴿鐘", "中文語音鴿鐘(G)", _
- "英文語音鴿鐘(G)", "凹槽", "CI", "單格15PIN", "單格9PIN", "四合一15PIN-E", "四合一15PIN-EL", _
- "四合一9PIN", "GPS(方形)", "525電匠", "747電匠", "T+1感應板", "傳訊機5V", "傳訊機非5V", "UID讀碼機")
- '*** 防呆
- If ComboBox2 = "" Then Msg = "地區單位 未選擇 !!!"
- If in1 = False And out1 = False Then Msg = IIf(Msg = "", "出貨情況 未選擇 !!!", Msg & Chr(10) & "出貨情況 未選擇 !!!")
-
- t = Application.Match(Val(Mid(TextBox1, 1, 6)), 序號, 0) '先找6位
- If IsError(t) Then t = Application.Match(Val(Mid(TextBox1, 1, 4)), 序號, 0) '後找4位
- If Not IsError(t) Then s = 品名(t - 1)
- If IsError(t) Then Msg = IIf(Msg = "", "序號錯誤: 找不到 品名 ???", Msg & Chr(10) & "序號錯誤: 找不到 品名 ???")
- If Msg <> "" Then
- MsgBox Msg
- Exit Sub
- End If
- '*** 防呆結束
- With Cells(Rows.Count, "A").End(xlUp).Offset(1) '工作表(ComboBox2)
- .Offset(0, 0) = abcName.Value
- .Offset(0, 1) = ComboBox2.Value
- .Offset(0, 2).Value = IIf(in1 = True, "收回", "發出")
- .Offset(0, 3) = TextBox1.Value
- .Offset(0, 4) = s
- End With
- End Sub
- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
- Dim rng As Range, i As Long, r
- If Sh.Index > 3 Then ' Index 各單位工作表於活頁簿的排序位置
- r = isTrue(Target.Value, getRangeString)
- If r(0) Then MsgBox "" & r(1) & "表中已經有了！"
- With Target
- If .Column = 1 Or .Column = 3 Or .Column = 4 Then
- If Cells(.Row, 1) <> "" And Cells(.Row, 3) <> "" And Cells(.Row, 4) <> "" Then
- For i = 2 To Cells(Rows.Count, .Column).End(xlUp).Row
- If Cells(i, 1) = Cells(.Row, 1) And Cells(i, 3) = Cells(.Row, 3) And Cells(i, 4) = Cells(.Row, 4) And i <> .Row Then
- If rng Is Nothing Then
- Set rng = Union(Cells(i, 1), Cells(i, 3), Cells(i, 4))
- Else
- Set rng = Union(rng, Cells(i, 1), Cells(i, 3), Cells(i, 4))
- End If
- End If
- Next
- If Not rng Is Nothing Then
- Set rng = Union(rng, Cells(i, 1), Cells(.Row, 3), Cells(.Row, 4))
- rng.Select
- MsgBox Cells(.Row, 1) & " " & Cells(.Row, 3) & " " & Cells(.Row, 4) & " 有重複檢查一下!!"
- End If
- End If
- End If
- End With
- End If
- End Sub
|
|
發表於 2011-12-29 21:42
| 
