返回列表 上一主題 發帖

[發問] 儲存格內有函數，但想要手動輸入時會讓原有函數不見

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
1# 跳轉到 »
發表於 2014-10-14 23:54 | 顯示全部帖子
儲存格內有函數，但想要手動輸入時會讓原有函數不見
還有交叉比對的問題
請問要怎麼改才好
希望用VBA(其 ...
j88141 發表於 2014-4-4 15:21

Module1 :
  1. Public v11, v12, v21, v22
複製代碼
Workbook :
  1. Private Sub Workbook_Open()
  2.   Dim vA
  3.   Dim rSou As Range, rTar As Range
  4.   
  5.   Set v11 = CreateObject("Scripting.Dictionary")
  6.   Set v12 = CreateObject("Scripting.Dictionary")
  7.   Set v21 = CreateObject("Scripting.Dictionary")
  8.   Set v22 = CreateObject("Scripting.Dictionary")
  9.   
  10.   Set rSou = Sheets("工作表1").Range("A:A").SpecialCells(xlCellTypeConstants)
  11.   For Each rTar In rSou
  12.     If rTar <> "" And Left(rTar, 2) <> "星期" Then v11(CStr(rTar)) = 1
  13.   Next
  14.   
  15.   Set rSou = Sheets("工作表1").Range("C:C").SpecialCells(xlCellTypeConstants)
  16.   For Each rTar In rSou
  17.     If rTar <> "" And Left(rTar, 2) <> "星期" Then v12(CStr(rTar)) = 1
  18.   Next

  20.   Set rSou = Sheets("工作表2").Range("A:A").SpecialCells(xlCellTypeConstants)
  21.   For Each rTar In rSou
  22.     If rTar <> "代號" Then
  23.       v21(CStr(rTar)) = rTar.Offset(, 1)
  24.       v22(CStr(rTar)) = rTar.Offset(, 2)
  25.     End If
  26.   Next
  27. End Sub
複製代碼
工作表3 :
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   Dim bNFind As Boolean
  3.   
  4.   With Target
  5.     If .Count = 1 Then
  6.       If .Row = 1 Then ' A1 或 B1
  7.         bNFind = True
  8.         Select Case .Column
  9.         
  10.         Case 1
  11.           If v11.exists(CStr(v22(CStr(Target)))) Then
  12.             .Offset(1) = v21(CStr(Target))
  13.             .Offset(2) = v22(CStr(Target))
  14.             bNFind = False
  15.           End If

  17.         
  18.         Case 2
  19.           If v12.exists(CStr(v22(CStr(Target)))) Then
  20.             .Offset(1) = v21(CStr(Target))
  21.             .Offset(2) = v22(CStr(Target))
  22.             bNFind = False
  23.           End If
  24.         
  25.         Case Else
  26.            bNFind = False
  27.            
  28.         End Select
  29.         
  30.         If bNFind Then
  31.           MsgBox v22(CStr(Target)) & " 沒有排班"
  32.           .Resize(3).ClearContents
  33.           .Select
  34.         End If
  35.       End If
  36.     End If
  37.   End With
  38. End Sub
複製代碼
活頁簿1-a.zip (19.91 KB)

TOP

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
返回列表 上一主題