123
返回列表 上一主題 發帖

[發問] EXCEL VBA 的問題

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-4-12 15:44 | 只看該作者

[發問] EXCEL VBA 的問題

請問附表的檔案中，如何在工作表1中表格，使用VBA找出甲、乙、丙的最後一列數值和日期寫到工作表2中，請叫有路過的大哥可以指導一下，謝謝

另再請教，假如甲乙丙丁(欄位)有很多個，那VBA的語法又該如何調整呢

tt.rar (7.22 KB)

TT

收藏 分享

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2015-4-12 23:51 | 只看該作者
回復 1# idnoidno
  1. Sub 巨集1()
  2. n = 1
  3. For Each Rng In 工作表1.Range("B1", 工作表1.Cells(1, Columns.Count).End(xlToLeft).Address) '第一列"動態"讀取做循環
  4.     RngRow = 工作表1.Columns(Rng.Column).Find("*", , , , , xlPrevious).Row '尋找改欄的最後一個儲存格
  5.     工作表2.Cells(n, 1) = Cells(RngRow, 1) '日期寫入工作表2
  6.     工作表2.Cells(n, 2) = Cells(RngRow, Rng.Column) '最後的數值寫入工作表2
  7.     n = n + 1
  8. Next
  9. End Sub
複製代碼

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
3#
發表於 2015-4-13 08:30 | 只看該作者
感謝大大的回復，我來研究試試看，不懂的，希望您可以接受我的請益
謝謝

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
4#
發表於 2015-4-13 12:59 | 只看該作者
請問阿lpk187大大
執行的結果有點不一樣
另外loop好像太多次

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2015-4-13 13:44 | 只看該作者
回復 4# idnoidno

我再執行一次，結果是你要的意思，不過我還是修改一下
  1. Sub 巨集1()
  2. n = 1
  3. For Each Rng In 工作表1.Range("B1", 工作表1.Cells(1, Columns.Count).End(xlToLeft).Address) '第一列"動態"讀取做循環
  4.     RngRow = 工作表1.Columns(Rng.Column).Find("*", , , , , xlPrevious).Row '尋找改欄的最後一個儲存格
  5.     工作表2.Cells(n, 1) = Rng
  6.     工作表2.Cells(n, 2) = 工作表1.Cells(RngRow, 1) '日期寫入工作表2
  7.     工作表2.Cells(n, 3) = 工作表1.Cells(RngRow, Rng.Column) '最後的數值寫入工作表2
  8.     n = n + 1
  9. Next
  10. End Sub
複製代碼
二、我程序是做動態循環，以你上傳的檔案去做的，依這個檔案只做了"甲乙丙"3次循環，所以你說的太多Loop是指3次太多嗎？

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-4-13 13:51 | 只看該作者
回復 4# idnoidno

執行結果如下2圖
   
A.png
2015-4-13 13:49


B.png
2015-4-13 13:49

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
7#
發表於 2015-4-13 14:06 | 只看該作者
大大，謝謝，可以和你線上請益依下嗎

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
90  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-4-18 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2015-4-13 14:17 | 只看該作者
回復 6# lpk187
  1. Sub ex()
  2. Dim Ar()
  3. Dim A As Range
  4. With 工作表1
  5. For Each A In .Range(.[B1], .[B1].End(xlToRight))
  6.    c = Application.Lookup(9.9E+307, A.EntireColumn)
  7.    d = Application.Lookup(9.9E+307, A.EntireColumn, .Columns("A"))
  8.    ReDim Preserve Ar(s)
  9.    Ar(s) = Array(A.Value, CDate(d), c)
  10.    s = s + 1
  11. Next
  12. With 工作表2
  13.    .UsedRange.ClearContents
  14.    .[A1].Resize(s, 3) = Application.Transpose(Application.Transpose(Ar))
  15. End With
  16. End With
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2015-4-13 14:20 | 只看該作者
回復 7# idnoidno


    要如何線上，我不會耶！

TOP

idnoidno

帖子
52 
主題
12 
精華
0 
積分
63 
點名
0  
作業系統
window 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-8-15 
最後登錄
2023-3-24 
10#
發表於 2015-4-13 14:22 | 只看該作者
哇謝謝版主出手回應
小弟才學粗淺，可能要好好的研讀了
還是十分感謝版主

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
123
返回列表 上一主題