麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何橫向填入資料 [打印本頁]

作者: jesscc 時間: 2018-10-27 21:39 標題: 如何橫向填入資料

用Sheets("E")去比對Sheets("DATA")，在"DATA"抓出相關資料，橫向填入Sheets("E")對應位置。從來沒這樣處理過資料，不知該如何做?
[attach]29598[/attach]

作者: faye59 時間: 2018-10-27 22:29

回復 1# jesscc

是這樣嗎?(此為新版RAR無法解壓縮請更新Win RAR 5.60)

Private Sub CommandButton1_Click()
'Module1.Ext
Dim f1, f2, f3 As Workbook '宣告活頁簿變數
Set f1 = Sheets("DATA") '新增活頁簿名稱
Set f2 = Sheets("E") '新增活頁簿名稱
f2.[F5:Z1000] = "" '清除範圍資料，確保每次執行資料更新
For Each aa In f2.Range([D5], [D5].End(xlDown)) 'D5開始向下迴圈讀取
X = 0 '數值
For i = 5 To Application.CountA(f1.Range("E:E")) + 3 '迴圈數值(起始位置關係所以總數+3)
If aa.Offset(, 0) = f1.Cells(i, 5) Then '比對名稱相符執行
If aa.Offset(, 8 + X) = "" Then '比對該aa處往右第8格是否空白
aa.Offset(, 8 + X) = f1.Cells(i, 2) '空白填入"DATA"PN的值
aa.Offset(, 9 + X) = f1.Cells(i, 1) '空白填入"DATA"VEN的值
Else '不是空白往右2個，迴圈i-1重覆一次迴圈，直到填入為止
X = X + 2
i = i - 1
End If
End If
Next i
Next aa
End Sub

複製代碼

作者: jesscc 時間: 2018-10-27 23:51

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

作者: jesscc 時間: 2018-10-28 18:47

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

作者: faye59 時間: 2018-10-28 20:45

回復 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資料轉換時就必須敘述清楚或是引用項目。

作者: faye59 時間: 2018-10-28 20:58

回復 4# jesscc

Cells(5000, 5).End(xlUp).Row
你看看當前活頁簿的值是多少~沒錯的話是7
就是Sheets("E")的E欄位0.896、0.896、6.3385這裡
如果且換到"DATA"的話E欄位應該值為12

作者: n7822123 時間: 2018-10-30 11:53

回復 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

作者: 准提部林 時間: 2018-10-30 13:00

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

作者: 千暉尋 時間: 2018-12-5 09:26

回復 8# 准提部林
準大的語法可以用在vlookup反向查詢,且是適用多個相同條件出現的狀況下,也是一直在尋找的技法,受教了.

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