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

標題: [發問] 利用儲存格中的部分關鍵字，取出同一列的相關資料 [打印本頁]

作者: jesscc 時間: 2011-9-17 00:09 標題: 利用儲存格中的部分關鍵字，取出同一列的相關資料

想了好久，還是沒頭緒，寫得亂七八糟。附檔中有詳細說明，求解!
[attach]7858[/attach]

作者: GBKEE 時間: 2011-9-17 11:20

回復 1# jesscc

Sub Test()
Dim D As Object, Ky As Variant
Set D = CreateObject("Scripting.Dictionary")
With Sheets("DATA")
For Each Ky In Range(.[B5], .[B5].End(xlDown))
D(Ky.Value) = Array(Ky.Offset(0, 2), Ky.Offset(0, 4))
'=> D(Ky.Value) =Array( Ky.Cells(1, 3), Ky.Cells(1, 5))
'=> D(Ky.Value) = Array(Ky(1, 3), Ky(1, 5))
Next
End With
With Sheets("Sheet2")
If .Range("E7").End(xlDown).Row = Rows.Count Then Exit Sub
For Each Ky In .Range(.[E7], .[E7].End(xlDown))
If D.Exists(Ky.Value) Then
If D(Ky.Value)(1) Like "*C" Then
Ky.Offset(0, 7) = D(Ky.Value)(0) '=> .Cells(E.Row, "L")= D(Ky.Value)(0)
If Ky.Offset(0, 8) = "" Then 'Range("O7:O" & yRow).Formula = "=N7*1000/L7"
Ky.Offset(0, 10) = Ky.Offset(0, 9) * 1000 / Ky.Offset(0, 7)
'=> .Cells(e.Row, "O")=.Cells(e.Row, "N")*1000/.Cells(e.Row, "L")
Else 'Range("O7:O" & yRow).Formula = "=M7*L7"
Ky.Offset(0, 10) = Ky.Offset(0, 8) * Ky.Offset(0, 7)
'=> .Cells(E.Row, "O") = .Cells(E.Row, "M") * .Cells(E.Row, "L")
End If
End If
End If
Next
End With
End Sub

複製代碼

Sub Ex()
Dim Ar(), E As Range, W As Variant
With Sheets("DATA")
Ar = .Range("B5:F" & .[B4].End(xlDown).Row).Value
End With
Ar = Application.WorksheetFunction.Transpose(Ar)
With Sheets("SHEET2")
For Each E In .Range("E7", .[E7].End(xlDown))
W = Application.Match(E, Application.Index(Ar, 1), 0)
If IsNumeric(W) Then
If Application.Index(Ar, 5)(W) Like "*C" Then
.Cells(E.Row, "L") = Application.Index(Ar, 3)(W)
If .Cells(E.Row, "M") = "" Then 'Range("O7:O" & yRow).Formula = "=N7*1000/L7"
.Cells(E.Row, "O") = .Cells(E.Row, "N") * 1000 / .Cells(E.Row, "L")
Else 'Range("O7:O" & yRow).Formula = "=M7*L7"
.Cells(E.Row, "O") = .Cells(E.Row, "M") * .Cells(E.Row, "L")
End If
End If
End If
Next
End With
End Sub

複製代碼

Sub Ex1()
Dim Ar(), Ay(), i As Integer, W As Variant
With Sheets("DATA")
Ar = .Range("B5:F" & .[B4].End(xlDown).Row).Value
End With
Ar = Application.WorksheetFunction.Transpose(Ar)
With Sheets("SHEET2")
Ay = .Range("E7:O" & .[E7].End(xlDown).Row).Value
For i = 1 To UBound(Ay)
W = Application.Match(Ay(i, 1), Application.Index(Ar, 1), 0)
If IsNumeric(W) Then
If Application.Index(Ar, 5)(W) Like "*C" Then
Ay(i, 8) = Application.Index(Ar, 3)(W)
If Ay(i, 9) = "" Then 'Range("O7:O" & yRow).Formula = "=N7*1000/L7"
Ay(i, 11) = Ay(i, 10) * 1000 / Ay(i, 8)
Else 'Range("O7:O" & yRow).Formula = "=M7*L7"
Ay(i, 11) = Ay(i, 9) * Ay(i, 8)
End If
End If
End If
Next
.Range("E7:O" & .[E7].End(xlDown).Row) = Ay
End With
End Sub

複製代碼

作者: jesscc 時間: 2011-9-17 12:53

回復 2# GBKEE

謝謝G大一次教我三種作法，第一種作法我比較能看得懂。其中的第十八行，如果除數為0的時候，程式會出現除錯，要如何避免這種情形? 還有我要用Rounddown將計算結果無條件取至整數，該如何套用?

作者: GBKEE 時間: 2011-9-17 13:20

回復 3# jesscc

If Ky.Offset(0, 8) = "" And Ky.Offset(0, 9) <> "" Then
Ky.Offset(0, 10) = Int(Ky.Offset(0, 9) * 1000 / Ky.Offset(0, 7))
ElseIf Ky.Offset(0, 8) <> "" Then
Ky.Offset(0, 10) = Int(Ky.Offset(0, 8) * Ky.Offset(0, 7))
End If

複製代碼

作者: jesscc 時間: 2011-9-17 13:46

回復 4# GBKEE
了解
Round、RoundUp、Rounddown 這些函數只能用在公式裏嗎?

作者: GBKEE 時間: 2011-9-17 15:27

回復 5# jesscc
VBA提供一些工作表函數可用.
找出可用的工作表函數 : Application.WorksheetFunction. -> . 之後下可選擇
PS: VBA指令工具->選項-> 勾選: 自動列出成員

作者: jesscc 時間: 2011-9-17 17:30

本帖最後由 jesscc 於 2011-9-17 17:43 編輯

回復 6# GBKEE

這一點我知道
我的疑問是如果我要四捨五入而不是取整數，用Round函數，程式不理我，那我該用什麼函數?
還有一點

Range("O:O") = ""
Dim yRow&
yRow = [E65536].End(xlUp).Row
If yRow < 7 Then Exit Sub
If Range("M7:M" & yRow) = "" And Range("N7:N" & yRow) <> "" And Range("L7:L" & yRow) <> "" Then
Range("O7:O" & yRow).Formula = "=Rounddown(N7*1000/L7,0)"
Else
Range("O7:O" & yRow).Formula = "=M7*L7"
End If
Range("O7:O500").Value = Range("O7:O500").Value

複製代碼

代碼中的第五行，一直出現除錯"型態不符合"，And不能這樣連接嗎?

作者: GBKEE 時間: 2011-9-17 18:59

回復 7# jesscc
沒有不理你是語法錯誤
If Range("M7:M" & yRow) = "" And Range("N7:N" & yRow) <> "" And Range("L7:L" & yRow) <> "" Then
Range("M7:M" & yRow) = "" ->這範圍中沒資料是嗎? Application.CountA(Range("M7:M" & yRow)) = 0
Range("N7:N" & yRow) <> "" -> 這範圍中有資料是嗎? Application.CountA(Range("N7:N" & yRow)) > 0

工作表函數 : CountA 計算不是空白的儲存格數量 , 以及引數清單中的數值
If Application.CountA(Range("M7:M" & yRow)) = 0 And Application.CountA(Range("N7:N" & yRow)) > 0 And Application.CountA(Range("L7:L" & yRow)) > 0 Then

作者: jesscc 時間: 2011-9-17 19:19

回復 jesscc
沒有不理你是語法錯誤
If Range("M7:M" & yRow) = "" And Range("N7:N" & yRow) "" And ...
GBKEE 發表於 2011-9-17 18:59

G大，抱歉我貼錯了，應該是指同一列的資料，而不是計算所有空白儲存格
If Range("M7:M" & yRow) = "" And Range("M7:M" & yRow).Office(,1) <> "" And Range("M7:M" & yRow).Office(,-1) <> "" Then
Range("O7:O" & yRow).Formula = "=Rounddown(N7*1000/L7,0)"
Else
Range("O7:O" & yRow).Formula = "=M7*L7"
End If
像上面這樣，語法不知錯在哪裡?

作者: GBKEE 時間: 2011-9-17 19:28

回復 9# jesscc
If Range("M7:M" & yRow) = "" And Range("M7:M" & yRow).Office(,1) <> "" And Range("M7:M" & yRow).Office(,-1) <> "" Then

應該是指同一列的資料，而不是計算所有空白儲存格 : 沒看到同一列的變數
If Range("M"&同一列) = "" And Range("M" &同一列).Office(,1) <> "" And Range("M" &同一列).Office(,-1) <> "" Then

作者: jesscc 時間: 2011-9-17 20:23

回復 10# GBKEE

附上修改後的檔案，請G大操作一下就知道了
[attach]7861[/attach]

作者: GBKEE 時間: 2011-9-17 21:11

回復 11# jesscc
用 R1C1 表示法

Sub Test1()
Dim KY As Range
With Sheets("Sheet2")
If .Range("E7").End(xlDown).Row = Rows.Count Then Exit Sub
For Each KY In .Range(.[E7], .[E7].End(xlDown)).Offset(, 8) 'M欄
If KY = "" And KY.Offset(, 1) <> "" And KY.Offset(, -1) <> "" Then
KY.Offset(, 2) = "=Rounddown(RC[-1]*1000/RC[-3],0)"
Else
KY.Offset(, 2) = "=RC[-2]*1000/RC[-3]"
End If
KY.Offset(, 2) = KY.Offset(, 2).Value
Next
End With
End Sub

複製代碼

作者: jesscc 時間: 2011-9-17 22:01

本帖最後由 jesscc 於 2011-9-17 22:09 編輯

回復 12# GBKEE

我的問題就在這裡
搞不懂為什麼用一個物件變數來取代Range，整個判斷式就可以用多個And 連接?

還有前面那個第18行的問題
為什麼這樣可以
Ky.Offset(0, 10) = Int(Ky.Offset(0, 9) * 1000 / Ky.Offset(0, 7))

這樣就不行
Ky.Offset(0, 10) = Rounddown((Ky.Offset(0, 9) * 1000 / Ky.Offset(0, 7)),0)

如果是要四捨五入，這段不知該用什麼函數?

作者: Hsieh 時間: 2011-9-17 22:55

本帖最後由 Hsieh 於 2011-9-17 23:07 編輯

回復 13# jesscc

Rounddown是工作表函數
Ky.Offset(0, 10) = Application.Rounddown((Ky.Offset(0, 9) * 1000 / Ky.Offset(0, 7)),0)

作者: jesscc 時間: 2011-9-17 23:30

回復 14# Hsieh

1.第一個問題還是搞不懂><
2.所有的工作表函數，運用到VBA裏都是這種轉換方式嗎?

作者: oobird 時間: 2011-9-18 00:03

可以拖動這個下拉清單，查看VBA支援的工作表函數
[attach]7863[/attach]

作者: jesscc 時間: 2011-9-18 00:18

了解了。
謝謝 H大和 O大的幫忙。更要謝謝G大，幾乎陪了我一下午的時間幫我解決問題，真的非常感謝!
另外，第一個問題我會再繼續努力找答案的。

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