返回列表 上一主題 發帖

[發問] 如何橫向填入資料

[發問] 如何橫向填入資料

用Sheets("E")去比對Sheets("DATA"),在"DATA"抓出相關資料,橫向填入Sheets("E")對應位置。從來沒這樣處理過資料,不知該如何做?
E_TEST.rar (25.81 KB)
Jess

回復 1# jesscc


    是這樣嗎?(此為新版RAR無法解壓縮請更新Win RAR 5.60)
  1. Private Sub CommandButton1_Click()
  2. 'Module1.Ext
  3. Dim f1, f2, f3 As Workbook '宣告活頁簿變數
  4. Set f1 = Sheets("DATA") '新增活頁簿名稱
  5. Set f2 = Sheets("E") '新增活頁簿名稱
  6. f2.[F5:Z1000] = "" '清除範圍資料,確保每次執行資料更新
  7. For Each aa In f2.Range([D5], [D5].End(xlDown)) 'D5開始向下迴圈讀取
  8. X = 0 '數值
  9.     For i = 5 To Application.CountA(f1.Range("E:E")) + 3 '迴圈數值(起始位置關係所以總數+3)
  10.     If aa.Offset(, 0) = f1.Cells(i, 5) Then '比對名稱相符執行
  11.         If aa.Offset(, 8 + X) = "" Then '比對該aa處往右第8格是否空白
  12.             aa.Offset(, 8 + X) = f1.Cells(i, 2) '空白填入"DATA"PN的值
  13.             aa.Offset(, 9 + X) = f1.Cells(i, 1) '空白填入"DATA"VEN的值
  14.         Else '不是空白往右2個,迴圈i-1重覆一次迴圈,直到填入為止
  15.             X = X + 2
  16.             i = i - 1
  17.         End If
  18.     End If
  19.     Next i
  20. Next aa
  21. End Sub
複製代碼

E_TEST.rar (27.33 KB)

一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

回復 2# faye59
正是我要的結果,謝謝大大。
Jess

TOP

回復 2# faye59
f大,我有個小問題
我把Application.CountA(f1.Range("E:E")) + 3
改成Cells(5000, 5).End(xlUp).Row
傳回的數值是一樣的,但為什麼執行會不正常?
Jess

TOP

回復 4# jesscc


    因為"活頁簿"
可以在For i 前加入f1.Select,
或是f1.Cells(5000, 5).End(xlUp).Row,
不過我寫的不太適合用Select。

我在前面已經先Set f1及f2活頁簿
所以就沒有f1.Select的動作。

關於Excel試算表儲存格公式這點我說明一下:
Workbook(工作表).Sheets(活頁簿).Range or Cells or Offset(儲存格位置)
你告訴程式執行位置因該如此,
但為什麼只要打Cells一樣能做動呢?
因為這是Excel VBA
程序在執行時判讀的是當前活頁簿,
如果以後你有寫到其它程式語言就會應用得到此公式。

用VB.net舉個例子
VB.net(甲員郵差);Excel(乙員住戶)
甲員今天送信到乙員家,
地址只寫520號,
到達目的後隨即投入520號1樓,
但其實乙員家住2樓,
這時是不是就送錯信了。

一樣邏輯,
把位置寫詳細比較好,
但是目前僅執行VBA部分,
所以有些地方我們是可以省略的,
但在其它Sheet資料轉換時就必須敘述清楚或是引用項目。
一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

回復 4# jesscc

Cells(5000, 5).End(xlUp).Row
你看看當前活頁簿的值是多少~沒錯的話是7
就是Sheets("E")的E欄位0.896、0.896、6.3385這裡
如果且換到"DATA"的話E欄位應該值為12
一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

回復 1# jesscc


在"E" 工作表 執行以下巨集(簡單寫法)

Sub Ext()
For R = 5 To [D4].End(xlDown).Row
  Cells(R, 12) = Sheets("DATA").Range("E:E").Find(Cells(R, 4), LookAt:=xlWhole).Offset(, -3).Value
  Cells(R, 13) = Sheets("DATA").Range("E:E").Find(Cells(R, 4), LookAt:=xlWhole).Offset(, -4).Value
Next R
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

Sub Ext()
Dim xR As Range, d, R&, C&
Range([E!A1], Sheets("E").UsedRange).Offset(4, 11).ClearContents
Set d = CreateObject("Scripting.Dictionary")
For Each xR In Range([E!D5], [E!D65536].End(xlUp))
    If xR <> "" Then d(xR & "") = xR.Row
Next
For Each xR In Range([DATA!E5], [DATA!E65536].End(xlUp))
    R = d(xR & ""):   If R = 0 Then GoTo 101
    d(xR & "//") = d(xR & "//") + 2:  C = d(xR & "//")
    [E!L1].Cells(R, C - 1).Resize(1, 2) = Array(xR(1, -2), xR(1, -3))
101: Next
End Sub
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題