VBA在管理系統的運用實例(三)

接上月的內容，管理系統最主要的功能是可以做各種需要的資料查詢，如果發現輸入的資料有問題，就會需要做資料修改。同樣的操作介面，我們今天來做資料修改的程式，近期都會有網友提出討論，若有問題，我們持續做進一步的探討，還是一樣，可以私訊、文章下留言、MAIL或SKYPE等，希望更多有興趣的朋友加入：

Sub 工程的資料修改()
Application.ScreenUpdating = False
Dim Message, Title, Default, CheckSame
Dim i, j, k, ir, ic As Long
Dim m0, cif, last As Long
Dim rsf, rc, rs, rt As Long
Dim y, m, d1, d2, n, s, t As Variant
Dim d As Date
Dim r As Long
Sheets("工程").Select
ActiveSheet.Unprotect Password:="*****"
Cells(1, "N") = "資料修改"
s = Cells(22, "G")
m0 = Cells(2, "G")
If s = "" Then
    MsgBox "請先查詢資料！"
Else
If m0 < 1 Then
    MsgBox "資料庫無 ( " & s & " ) 的工程單號資料！"
Else
If Cells(23, "G") <> Cells(2, "R") Then
    MsgBox "工程名稱不可修改！"
Else
If Cells(23, "I") = "" Then
    MsgBox "客戶編號須有資料！"
Else
    r = MsgBox("要修改 ( " & s & " ) 的資料？", _
        vbQuestion + vbOKCancel, "確認進行修改")
      If r = vbOK Then
        Sheets("工程資料").Visible = True
        Sheets("工程").Select
     '如果使用函數導至K欄
        Range("Q1:Q6").Copy
        Sheets("工程資料").Select
        Cells(m0, "A").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Sheets("工程資料").Visible = xlVeryHidden
 '以預設範圍複製貼上，使用者可能從別處貼過來，復原
        Sheets("工程").Select
        Range("E7:J10").Copy
        Range("E22").Select
        ActiveSheet.Paste
        Cells(2, "N") = "資料修改"
            MsgBox s & " 資料已修改！"
      Else
        MsgBox "修改取消", _
            vbInformation + vbOKOnly, "使用者取消修改動作"
      End If
End If
End If
End If
End If
Sheets("工程").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="*****"
Range("A3").Select
End Sub

VBA在管理系統的運用實例(二)

接上月的內容，管理系統最主要的功能是可以做各種需要的資料查詢，這個月我們來做資料查詢的功能，同樣的操作介面，我們先來做單筆資料的資料查詢，上個月有網友私訊討論，若有問題，我們持續做討論，可以私訊、文章下留言、MAIL或SKYPE等，希望更多有興趣的朋友加入：

Sub 客戶的資料查詢()
Application.ScreenUpdating = False
Dim i, j, k, ir, ic As Long
Dim m0, cif, last As Long
Dim rsf, rc, rs, rt As Long
Dim y, m, d1, d2, n, s, t As Variant
Dim d As Date
Dim r As Long
Sheets("客戶").Select
ActiveSheet.Unprotect Password:="*****"
Cells(1, "N") = "資料查詢"
If ActiveCell = "" Then
    MsgBox "選取的是空的資料，請選取客戶名稱下的項目進行操作！"
     Range("C19").Select
Else
    Sheets("客戶").Select
    ir = ActiveCell.Row
    ic = ActiveCell.Column
  If ic = 3 And ir > 20 Then
    'Cells(22, "G") = ActiveCell
    s = ActiveCell
    Range("E7:M15").Copy
    Range("E22").Select
    ActiveSheet.Paste
    Cells(16, "C") = s
    Cells(22, "G") = Cells(17, "C")
    'Cells(22, "G") = Cells(1, "R")      '客戶編號
    If Cells(2, "R") <> "" Then Cells(23, "G") = Cells(2, "R")   '客戶名稱
    If Cells(3, "R") <> "" Then Cells(22, "J") = Cells(3, "R")     
    If Cells(4, "R") <> "" Then Cells(24, "G") = Cells(4, "R")     
    If Cells(5, "R") <> "" Then Cells(25, "G") = Cells(5, "R")     
    If Cells(6, "R") <> "" Then Cells(26, "H") = Cells(6, "R")     
    If Cells(7, "R") <> "" Then Cells(27, "H") = Cells(7, "R")     
    If Cells(8, "R") <> "" Then Cells(28, "H") = Cells(8, "R")     
    If Cells(9, "R") <> "" Then Cells(29, "H") = Cells(9, "R")     
    If Cells(10, "R") <> "" Then Cells(22, "L") = Cells(10, "R")     
    If Cells(11, "R") <> "" Then Cells(23, "L") = Cells(11, "R")     
    If Cells(12, "R") <> "" Then Cells(24, "L") = Cells(12, "R")     
    If Cells(13, "R") <> "" Then Cells(25, "L") = Cells(13, "R")     
    If Cells(14, "R") <> "" Then Cells(26, "L") = Cells(14, "R")     
    If Cells(15, "R") <> "" Then Cells(27, "L") = Cells(15, "R")     
    If Cells(16, "R") <> "" Then Cells(28, "L") = Cells(16, "R")     
    If Cells(17, "R") <> "" Then Cells(29, "L") = Cells(17, "R")     
    If Cells(18, "R") <> "" Then Cells(30, "H") = Cells(18, "R")     
 '另一個方式，程式碼較簡單
    Cells(21, "C") = ""
    Cells(ir + 1, ic).Select
    Cells(2, "N") = "資料查詢"
  Else
    MsgBox "選取無效的儲存格，請選取客戶名稱下的項目進行操作！"
     Range("C19").Select
  End If
End If
Sheets("客戶").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="*****"
End Sub