Board logo

標題: [發問] 請教一下有關尋找複製的方法請各位高手指導一下!... 謝謝 [打印本頁]

作者: samneng    時間: 2016-1-19 18:35     標題: 請教一下有關尋找複製的方法請各位高手指導一下!... 謝謝

各位大大不好意思小的又有問題想請教一下!...
小的從樞紐分析表抓取資料後想將資料經由搜尋後複製到指定欄位
小的搜尋論壇發現都篩選功能比較多... 經由錄製巨集後更改但有些資料還是沒有辦法顯示!..
想請教各位大大錯誤的地方為何!.?
目前想要功能如下 :
[attach]23139[/attach]
[attach]23138[/attach]

小的有使用過簡易方式可以使用 , 但只要Weekly變更就必須變動請問是否有連續的語法呢?
  1. Dim myRng1 As Range, myRang2 As Range
  2. Set myRng1 = Sheets("轉寫紀錄").Range("B3:B19")
  3. Set myRng2 = Sheets("圖表分析By總數").Range("B9")
  4. With myRng1
  5.     Set myRng2 = myRng2.Resize(RowSize:=.Rows.Count, ColumnSize:=.Columns.Count)
  6.     End With
  7. myRng2.Value = myRng1.Value
  8. Set myRng1 = Nothing
  9. Set myRng2 = Nothing
複製代碼
另有錄製巨集後編寫如下 : 但似乎語法錯誤導致複製範圍失敗想請各位大大有空稍微指導一下即可!... 小的會自己努力研究的~... 抱歉!. 謝謝~
  1. Private Sub CommandButton2_Click()

  2. Dim i As Integer, k As Integer
  3. Dim ListRow As Range, myRange As Range
  4. Dim Week As Range

  5. With Sheets("圖表分析By總數")
  6. Set Week = Sheets("轉寫紀錄").Cells(1, 2)
  7. Set myRange = .Cells.Find(What:=Week, lookat:=xlWhole)
  8.     k = myRange.Row
  9.     For i = 9 To 25
  10.         '.Cells(i, k).Value = Sheets("轉寫紀錄").Cells(i, k)
  11.     Next

  12. With Sheets("轉寫紀錄")
  13.    
  14.     For i = [B65536].End(xlUp).Column To 1 Step -1
  15.                   
  16.         If Sheets("轉寫紀錄").Cells(i, 1).Value <> 0 Then
  17.             If Sheets("圖表分析By總數").Cells(9, k + 1).Value = "" Then
  18.                 Sheets("圖表分析By總數").Cells(9, k).Value = Sheets("轉寫紀錄").Cells(i, "B")
  19.             'Else
  20.                 'Sheets("圖表分析By總數").Cells(9, k).Value = Sheets("圖表分析By總數表").Cells(9, k).Value + 1
  21.             End If
  22.         End If

  23.     Next
  24. End With
  25. End With
  26. End Sub
複製代碼

作者: samneng    時間: 2016-1-21 16:50

不好意思請教各位大大
小的有依照GBKEE 大大所發的文章 : http://forum.twbts.com/thread-15664-1-8.html "搜尋序號對應的工作表,並將目標帶回搜尋列中"
模擬GBKEE 大大所寫的程式碼!... 試著增減某些語法但是還是沒有辦法依照週別變更複製到指定Sheets的週別下!...  (從橫的轉成直的帶入)
小的剛接觸Excel VBA沒多久所以有很多不懂得地方 , 抱歉請見諒!還是想在請問一下指定儲存格的複製方式!... 謝謝~~
  1. Private Sub CommandButton3_Click()
  2. Dim D As Object, Sh As Worksheet, Sh1 As Worksheet, fRng As Range, sRng As Range
  3. Dim I As Integer, J As Integer, sNum As String, FstAddr As String
  4. Set Sh = Sheets("圖表分析By總數")
  5. Set Sh1 = Sheets("轉寫紀錄")
  6.     For I = 5 To Sh.[B9].End(xlDown).Column
  7.         sNum = Sh.Cells(2, I)
  8.         For J = 3 To Sheets("轉寫紀錄").[B3].End(xlDown).Count
  9.             Sh1(J).Activate
  10.             Set sRng = Sh1(J).Range("B1")   '設定被搜尋的Range
  11.             sRng.Select
  12. '            On Error Resume Next
  13.             Set fRng = sRng.Find(sNum, lookat:=xlWhole)   '在Sheets(J)的sRng中尋找 序號
  14.             If Not fRng Is Nothing Then    '有找到
  15.                 Sh.Cells(I, 1) = fRng.Offset(0, -1)   '拷貝相關資料
  16.     End If
  17.         Next
  18. Next1:
  19.     Next
  20.     Sh.Activate

  21. End Sub
複製代碼





歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)