如何自行判斷並填入 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 如何自行判斷並填入

返回列表下一主題上一主題發帖

[發問] 如何自行判斷並填入

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

8^# 跳轉到 »

發表於 2014-4-28 22:29 | 只看該作者

回復 7# GBKEE
GBKEE 老師

這是我想出來的
因為一開始的只有一個符合項目就可以填入檔案2中

那如果需要符合兩個項目才可以填進
那程式碼需要怎麼改才行

檔案1+2(new).rar (29.82 KB)

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

7^#

發表於 2014-4-27 06:05 | 只看該作者

回復 6# j88141
2# ,5# 的程式碼都更新,可再看一次

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

6^#

發表於 2014-4-27 00:33 | 只看該作者

回復 5# GBKEE

GBKEE 老師

如果我想把地名改變  如  原始資料金門改成台北

但在檔案二好像還是會自動搜尋金門  然後填入

我這兩天查了 dictionary 這物件
知道要用d.RemoveAll 來清除字典中的數據
但卻不知道如何加入

順便一問  看不太懂這一句...
Set Rng(2) = Rng(1).CurrentRegion.Rows(Rng(1).Row & ":" & Rng(1).Row + 2)

謝謝GBKEE 老師

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2014-4-24 04:57 | 只看該作者

本帖最後由 GBKEE 於 2014-4-27 06:04 編輯

回復 4# j88141

Option Explicit
Dim D As Object
Private Sub Ex() 'Excel檔案(檔案2),加入一個CommandButton 的程式碼
Dim SH As Worksheet, Rng As Range
Dictionary_Ex '執行這個程序
For Each SH In Sheets 'Sheets :Excel檔案(檔案2)中的工作表集合
Set Rng = SH.[A2]
Do While Rng <> ""
If D.exists(Rng & SH.[A1]) Then '字典物件中有這 key 值
D(Rng & SH.[A1]).Copy Rng.Offset(, 1).Resize(3)
Else
Rng.Offset(, 1).Resize(3) = ""
End If
Set Rng = Rng.Offset(, 2) '向左移動2欄
Loop
Next
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

4^#

發表於 2014-4-23 21:11 | 只看該作者

回復 3# j88141

GBKEE老師

我還有一個問題
就是在資料2的A1 不是有地名嗎
可是好像要重新輸入才會觸發VBA
請問該怎麼修改
或是加入一個CommandButton呢

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

3^#

發表於 2014-4-23 12:46 | 只看該作者

回復 2# GBKEE

輸入之後怎麼會出現編譯錯誤
Dictionary_Ex
這一個沒有定義sub或 function

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2014-4-23 06:17 | 只看該作者

本帖最後由 GBKEE 於 2014-4-27 05:56 編輯

回復 1# j88141

自動填入到另一個excel檔案(檔案2)的ThisWorkbook程式碼

Option Explicit
Dim D As Object
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rng As Range
Application.EnableEvents = False
If Target.Address = "$A$1" Then
Dictionary_Ex
Set Rng = Sh.[A2]
Do While Rng <> ""
If D.exists((Rng & Target)) Then '字典物件中有這 key 值
D(Rng & Target).Copy Rng.Offset(, 1).Resize(3)
Else
Rng.Offset(, 1).Resize(3) = ""
End If
Set Rng = Rng.Offset(, 2) '向左移動2欄
Loop
End If
Application.EnableEvents = True
End Sub
Private Sub Dictionary_Ex()
Dim Rng(1 To 2) As Range, i As Integer, a
Set D = CreateObject("SCRIPTING.DICTIONARY")
With Workbooks("Xl0000001.xls").Sheets("工作表1") '原始資料檔案必須是開啟的
Set Rng(1) = .[A1] 'A欄的星期是合併3列的儲存格
Do While Rng(1) <> ""
Set Rng(2) = Rng(1).CurrentRegion.Rows(Rng(1).Row & ":" & Rng(1).Row + 2)
'CurrentRegion 屬性傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀
'Rng(1).Row + 2 : Rng(1)所在的列號+ 2
For i = 2 To Rng(2).Columns.Count '星期的欄位從第2欄開始到最後一欄
Set D(Rng(1) & Rng(2).Cells(3, i)) = Rng(2).Columns(i)
'Rng(1) :星期 , Rng(2).Cells(3, i) :地名
Next
Set Rng(1) = Rng(1).End(xlDown) '下一個星期的位置
Loop
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 天上最美是星星，人生最美是溫情。

返回列表下一主題上一主題