返回列表 上一主題 發帖

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

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-4-4 15:21 | 只看該作者

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

本帖最後由 j88141 於 2014-4-4 15:25 編輯

儲存格內有函數，但想要手動輸入時會讓原有函數不見
還有交叉比對的問題
請問要怎麼改才好
希望用VBA(其他方法也可以)
當然能解決最好
附圖說明，希望大家會比較清楚

        工作表 1                                                                          工作表2                              
            

                 工作表3



活頁簿1.rar (12.74 KB)
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2014-10-15 09:17 | 只看該作者
本帖最後由 GBKEE 於 2014-10-15 09:19 編輯

回復 3# luhpro
請參考一下
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim bNFind As Range
  4.     With Target
  5.         If .Count = 1 Then
  6.             If .Row = 1 And .Column <= 7 Then  ' A1 或 B1(星期一 到 星期日)
  7.                 .Range("A2").Resize(2) = ""
  8.                 .Range("A3").Validation.Delete
  9.                 If .Value = "" Then Exit Sub
  10.                 Application.EnableEvents = False
  11.                 Set bNFind = Sheets("工作表2").Range("A:A").Find(.Value, LookAT:=xlWhole)
  12.                 If Not bNFind Is Nothing Then
  13.                     .Offset(1) = bNFind.Range("B1")
  14.                     If 排班(bNFind.Range("C1"), Target) Then .Offset(2) = bNFind.Range("C1") & vbLf & "沒有排班"
  15.                 End If
  16.                 Application.EnableEvents = True
  17.             End If
  18.         End If
  19.     End With
  20. End Sub
  21. Private Function 排班(ByVal T1 As Range, T2 As Range) As Boolean
  22.     Dim bNFind As Range, S As String
  23.     With Sheets("工作表1")
  24.         Set bNFind = .Columns(T2.Column).Find(T1, LookAT:=xlWhole)
  25.         If Not bNFind Is Nothing Then
  26.             For Each bNFind In .Columns(T2.Column).SpecialCells(xlCellTypeConstants)
  27.                 If bNFind.Row > 1 And bNFind <> "" Then
  28.                     S = IIf(S <> "", S & "," & bNFind, bNFind)
  29.                 End If
  30.             Next
  31.         Else
  32.            排班 = True
  33.         End If
  34.         With T2.Range("A3")
  35.             If Not 排班 Then
  36.                 .Validation.Add Type:=xlValidateList, Formula1:=S
  37.                 .Value = T1
  38.             End If
  39.         End With
  40.     End With
  41. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
3#
發表於 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

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2014-10-7 23:00 | 只看該作者
回復 1# j88141



1.新增【工作表】名稱更為【資料庫】

2.請使用【名稱定義】，定義【代號】【種類】【姓名】
　　【代號】參照的公式：=OFFSET(資料庫!$A$1,,,COUNTA(資料庫!$AA),)
　　【種類】參照的公式：=OFFSET(資料庫!$B$1,,,COUNTA(資料庫!$BB),)
　　【姓名】參照的公式：=OFFSET(資料庫!$C$1,,,COUNTA(資料庫!$CC),)

******　以上輸入完成後，就算有增加筆數資料，【名稱定義】也會自動更新資料庫

3.再使用【資料驗證】=> 清單
　　【來源】公式：=代號
　　【來源】公式：=種類
　　【來源】公式：=姓名

4.詳情請看附件(用你給的表格修改的)

活頁簿1.rar (13.1 KB)

我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
返回列表 上一主題