jesscc

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-10-27 21:39 | 只看該作者

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

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

E_TEST.rar (25.81 KB)

樓主熱帖

Jess

faye59

　暱稱: 温奇
　頭銜: 議論者

中學生 Rank: 2

帖子: 104
主題: 5
精華: 0
積分: 110
點名: 0
作業系統: win7
軟體版本: Office2007
閱讀權限: 20
性別: 男
註冊時間: 2017-11-14
最後登錄: 2019-4-30

論壇榮譽勳章論壇贊助勳章

2^#

發表於 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

複製代碼

E_TEST.rar (27.33 KB)

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

TOP

jesscc

中學生 Rank: 2

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

3^#

發表於 2018-10-27 23:51 | 只看該作者

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

Jess

TOP

jesscc

中學生 Rank: 2

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

4^#

發表於 2018-10-28 18:47 | 只看該作者

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

Jess

TOP

faye59

　暱稱: 温奇
　頭銜: 議論者

中學生 Rank: 2

帖子: 104
主題: 5
精華: 0
積分: 110
點名: 0
作業系統: win7
軟體版本: Office2007
閱讀權限: 20
性別: 男
註冊時間: 2017-11-14
最後登錄: 2019-4-30

論壇榮譽勳章論壇贊助勳章

5^#

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

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

TOP

faye59

　暱稱: 温奇
　頭銜: 議論者

中學生 Rank: 2

帖子: 104
主題: 5
精華: 0
積分: 110
點名: 0
作業系統: win7
軟體版本: Office2007
閱讀權限: 20
性別: 男
註冊時間: 2017-11-14
最後登錄: 2019-4-30

論壇榮譽勳章論壇贊助勳章

6^#

發表於 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

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

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

7^#

發表於 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

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

8^#

發表於 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

TOP

千暉尋

中學生 Rank: 2

帖子: 36
主題: 7
精華: 0
積分: 77
點名: 0
作業系統: WIN7
軟體版本: MICROSOFT
閱讀權限: 20
註冊時間: 2015-6-7
最後登錄: 2024-9-22

論壇榮譽勳章論壇贊助勳章

9^#

發表於 2018-12-5 09:26 | 只看該作者

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

TOP