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
