如何利用VBA一鍵自動填入1或3呢?

RCRG

一鍵自動填入1或3.rar (11.86 KB)

如何一鍵自動填入1或3
下載次數: 8

2015-11-12 09:05

下載 (23.7 KB)

2015-11-12 09:06

lpk187

1. Sub 按鈕1_Click()
   
2. Dim Rng As Range
   
3. With Sheets("Sheet2")
   
4.     For Each Rng In .Range("C3:C79")
   
5.         If Rng <> "" Then
   
6.             Set da = .Range("AA3:AA500").Find(Rng.Value, LookAt:=xlWhole, SearchDirection:=2)
   
7.             If da Is Nothing Then
   
8.                 Rng.Offset(, -1) = 3
   
9.             Else
   
10.                 Rng.Offset(, -1) = 1
    
11.                 Set da = Nothing
    
12.             End If
    
13.         End If
    
14.     Next
    
15. End With
    
16. End Sub

複製代碼

回復 1# RCRG

准提部林

Sub TEST()
With [B3:B79]
　　　.Formula = "=IF(C3="""","""",3^(1-COUNT(MATCH(C3,AA$2:AA$500,))))"
　　　.Value = .Value
End With
[D1] = Now
End Sub

RCRG

謝謝兩位的回答，測試兩位的結果都是我要的答案，真的非常謝謝！自從知識+改版後，提出問題好像都石沉大海，索性讓我發現這個論壇，更讓我驚豔的是，以前曾經在舊版知識+幫我解答過的excel專家們竟然都在這兒，真的好讓我開心！希望日後還能獲得各位大大賜教與指導。

RCRG

回復 3# 准提部林


想請問一下准大相反做法，若符合號碼就填3，否則就填1，那公式要如何修改呢?

准提部林

回復 5# RCRG


=IF(C3="","",3^COUNT(MATCH(C3,AA$2:AA$500,)))
=IF(C3="","",IF(COUNT(MATCH(C3,AA$2:AA$500,)),3,1))
=IF(C3="","",IF(ISNA(MATCH(C3,AA$2:AA$500,)),1,3))

RCRG

回復 6# 准提部林


    原來如此，下面三個都可以通用是吧！可是好像會出現錯誤，自己反覆測試後，應該是少了""，所以如容許我把正解再PO一次吧！
   最後也再次謝謝 准大 囉！


=IF(C3="""","""",3^COUNT(MATCH(C3,AA$3:AA$500,)))
=IF(C3="""","""",IF(COUNT(MATCH(C3,AA$3:AA$500,)),3,1))
=IF(C3="""","""",IF(ISNA(MATCH(C3,AA$3:AA$500,)),1,3))

准提部林

回復 7# RCRG


提供的是工作表公式, 若要寫到VBA中, 遇有"??"包覆的文字, 都須再加一層""??"", 這是通則,
也可先使用錄製再貼入!

RCRG

Sub TEST()
With
　　　.Formula = "=IF(C3="""","""",3^(1-COUNT(MATCH(C3,AA$2:AA$500,))))"
　　　. ...
准提部林 發表於 2015-11-12 10:09

    謝謝准大的解題！

我想了解另一種不必按鈕的做法，就是不用按鍵也會直接幫我填入，而觸發填入時間點為：每當Sheet2的C3:C200任何一欄內容有異動時，B3:B79就全部再重新填入一次。

有點龜毛，但還是先跟各位大大說聲抱歉，麻煩指教了！>"<

准提部林

回復 9# RCRG


Private Sub Worksheet_Change(ByVal Target As Range)
With Target
　　　If Not Intersect([AA2:AA500], .Cells) Is Nothing Then
　　　　　With [Sheet2!B3:B79]
　　　　　　　　.Formula = "=IF(C3="""","""",3^COUNT(MATCH(C3,AA$2:AA$500,)))"
　　　　　　　　.Value = .Value
　　　　　End With
　　　　　[Sheet2!D1] = Now
　　　End If
End With
End Sub