標題:
[發問]
請教一下有關尋找複製的方法請各位高手指導一下!... 謝謝
[打印本頁]
作者:
samneng
時間:
2016-1-19 18:35
標題:
請教一下有關尋找複製的方法請各位高手指導一下!... 謝謝
各位大大不好意思小的又有問題想請教一下!...
小的從樞紐分析表抓取資料後想將資料經由搜尋後複製到指定欄位
小的搜尋論壇發現都篩選功能比較多... 經由錄製巨集後更改但有些資料還是沒有辦法顯示!..
想請教各位大大錯誤的地方為何!.?
目前想要功能如下 :
[attach]23139[/attach]
[attach]23138[/attach]
小的有使用過簡易方式可以使用 , 但只要Weekly變更就必須變動請問是否有連續的語法呢?
Dim myRng1 As Range, myRang2 As Range
Set myRng1 = Sheets("轉寫紀錄").Range("B3:B19")
Set myRng2 = Sheets("圖表分析By總數").Range("B9")
With myRng1
Set myRng2 = myRng2.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
End With
myRng2.Value = myRng1.Value
Set myRng1 = Nothing
Set myRng2 = Nothing
複製代碼
另有錄製巨集後編寫如下 : 但似乎語法錯誤導致複製範圍失敗想請各位大大有空稍微指導一下即可!... 小的會自己努力研究的~... 抱歉!. 謝謝~
Private Sub CommandButton2_Click()
Dim i As Integer, k As Integer
Dim ListRow As Range, myRange As Range
Dim Week As Range
With Sheets("圖表分析By總數")
Set Week = Sheets("轉寫紀錄").Cells(1, 2)
Set myRange = .Cells.Find(What:=Week, lookat:=xlWhole)
k = myRange.Row
For i = 9 To 25
'.Cells(i, k).Value = Sheets("轉寫紀錄").Cells(i, k)
Next
With Sheets("轉寫紀錄")
For i = [B65536].End(xlUp).Column To 1 Step -1
If Sheets("轉寫紀錄").Cells(i, 1).Value <> 0 Then
If Sheets("圖表分析By總數").Cells(9, k + 1).Value = "" Then
Sheets("圖表分析By總數").Cells(9, k).Value = Sheets("轉寫紀錄").Cells(i, "B")
'Else
'Sheets("圖表分析By總數").Cells(9, k).Value = Sheets("圖表分析By總數表").Cells(9, k).Value + 1
End If
End If
Next
End With
End With
End Sub
複製代碼
作者:
samneng
時間:
2016-1-21 16:50
不好意思請教各位大大
小的有依照GBKEE 大大所發的文章 :
http://forum.twbts.com/thread-15664-1-8.html
"搜尋序號對應的工作表,並將目標帶回搜尋列中"
模擬GBKEE 大大所寫的程式碼!... 試著增減某些語法但是還是沒有辦法依照週別變更複製到指定Sheets的週別下!... (從橫的轉成直的帶入)
小的剛接觸Excel VBA沒多久所以有很多不懂得地方 , 抱歉請見諒!還是想在請問一下指定儲存格的複製方式!... 謝謝~~
Private Sub CommandButton3_Click()
Dim D As Object, Sh As Worksheet, Sh1 As Worksheet, fRng As Range, sRng As Range
Dim I As Integer, J As Integer, sNum As String, FstAddr As String
Set Sh = Sheets("圖表分析By總數")
Set Sh1 = Sheets("轉寫紀錄")
For I = 5 To Sh.[B9].End(xlDown).Column
sNum = Sh.Cells(2, I)
For J = 3 To Sheets("轉寫紀錄").[B3].End(xlDown).Count
Sh1(J).Activate
Set sRng = Sh1(J).Range("B1") '設定被搜尋的Range
sRng.Select
' On Error Resume Next
Set fRng = sRng.Find(sNum, lookat:=xlWhole) '在Sheets(J)的sRng中尋找 序號
If Not fRng Is Nothing Then '有找到
Sh.Cells(I, 1) = fRng.Offset(0, -1) '拷貝相關資料
End If
Next
Next1:
Next
Sh.Activate
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)