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

標題: [發問] 垂直欄位項目轉至水平列顯示 [打印本頁]

作者: kasa 時間: 2015-12-23 15:23 標題: 垂直欄位項目轉至水平列顯示

本帖最後由 kasa 於 2015-12-23 15:25 編輯

請教各位大大,
如何讓附件各編號key in之Item可於第二列水平展開所對應之Item顯示"1"
例如:於編號3之B欄key 入"D1"後,而同步可讓"F5"儲存格顯示"1"
[attach]22943[/attach]
[attach]22943[/attach][attach]22944[/attach]

作者: hcm19522 時間: 2015-12-23 19:03

C3=IF(C$2=$B3,1,"")

作者: kasa 時間: 2015-12-23 22:00

我試著寫出以下巨集,結果是成功的,因我還屬自學的初心者
故有以下需請教各位前賢,請不吝指教,謝謝.
(1)是否有更好的寫法?
(2)如果B3~B14欄位原保持空白,要寫成當一key入代碼時,可自動變換對應欄位顯示"1",該如何運用worksheet_change語法加入此段巨集
要以如此寫法的用意是:就不用再額外有執行巨集的動作了
[attach]22952[/attach]

Option Explicit
Sub TESTsearch()
Dim i As Integer
For i = 3 To 14
Select Case Cells(i, 2)
   Case "A"
      Cells(i, 3) = 1
   Case "B"
      Cells(i, 4) = 1
   Case "C"
      Cells(i, 5) = 1
   Case "D1"
      Cells(i, 6) = 1
   Case "D2"
      Cells(i, 7) = 1
   Case "D3"
      Cells(i, 8) = 1
   Case "D4"
      Cells(i, 9) = 1
   Case "D5"
      Cells(i, 10) = 1
   Case "D6"
      Cells(i, 11) = 1
   Case "D7"
      Cells(i, 12) = 1
   Case "D8"
      Cells(i, 13) = 1
   Case "D9"
      Cells(i, 14) = 1
   Case "D10"
      Cells(i, 15) = 1
End Select
Next i
End Sub

作者: kasa 時間: 2015-12-23 22:09

搜索了worksheet_change語法,還是不太懂如何運用

作者: kasa 時間: 2015-12-23 22:53

嘗試用以下Worksheet_Change寫法,結果當在B3~B14逐一key入代碼後,C3~O14欄位沒反應,沒於對應代碼處顯示"1"

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Not Intersect(Target, Range("B3:B14")) Is Nothing Then
For i = 3 To 14
Select Case Cells(i, 2)
   Case "A"
      Cells(i, 3) = 1
   Case "B"
      Cells(i, 4) = 1
   Case "C"
      Cells(i, 5) = 1
   Case "D1"
      Cells(i, 6) = 1
   Case "D2"
      Cells(i, 7) = 1
   Case "D3"
      Cells(i, 8) = 1
   Case "D4"
      Cells(i, 9) = 1
   Case "D5"
      Cells(i, 10) = 1
   Case "D6"
      Cells(i, 11) = 1
   Case "D7"
      Cells(i, 12) = 1
   Case "D8"
      Cells(i, 13) = 1
   Case "D9"
      Cells(i, 14) = 1
   Case "D10"
      Cells(i, 15) = 1
End Select
Next i
End If
End Sub

作者: URCHEN 時間: 2015-12-24 06:12

小弟來獻醜一下，還請各位大大指教...

1. 工作表上新增一個 CommandButton1，命名為"更新"
2. 在 CommandButton1_Click 內輸入以下內容：

Option Explicit
Private Sub CommandButton1_Click()
Dim SH1W As Worksheet
Dim Ra1 As Range
Dim X, Y

Set SH1W = Sheets("工作表1")
Set Ra1 = SH1W.Range("B2:B" & [B65536].End(xlUp).Row)

X = Ra1.Offset(1, 0).Resize(1, 1).Value

SH1W.Range("C3:O14").ClearContents

For Each X In Range("B3:B14")
  For Each Y In Range("C2:O2")
If X = Y Then
   Y.Offset(X.Row - 2, Y.Row - 2).Resize(1, 1).Select
   Selection = "1"
End If
  Next Y
Next X

End Sub

小弟也是剛學VBA沒多久，如果有錯，還請各位大大包涵~

作者: 准提部林 時間: 2015-12-24 10:11

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, M
With Target
　　　If .Column <> 2 Or .Columns.Count > 1 Then Exit Sub　'非第２欄，或選取兩欄以上，跳出
　　　On Error GoTo 999　'發生錯誤時，執行標記９９９那行程式
　　　Application.EnableEvents = False　'關閉事件觸發
　　　For Each xR In .Cells　'歷遍選取區全部儲存格（可使用貼上多個）
　　　　　If xR.Row > 2 Then
　　　　　　xR(1, 2).Resize(1, 99).ClearContents　'清除右方原有資料
　　　　　　M = Application.Match(xR, [2:2], 0)　'找出Item在第２列的位置
　　　　　　If IsNumeric(M) Then xR(1, M - 1) = 1　'若有符合，填入１
　　　　End If
　　　Next
End With
999: Application.EnableEvents = True　'恢復事件觸發
End Sub

作者: yen956 時間: 2015-12-24 15:43

試試看:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MH, RngB As Range, Rng2 As Range
Set RngB = [B3:B65536] '輸入區
Set Rng2 = [C2:O2] '比對區
If Target.Count > 1 Then Exit Sub '如果兩格以上同時Change，跳出
If Not Intersect(Target, RngB) Is Nothing Then '如果 Target 與比對區有交集
If Target = "" Then
Cells(Target.Row, "B").Resize(1, 14) = "" '如果Change的是空白，清除該列
End If
MH = Application.Match(Target, Rng2, 0) '在比對區找出 Target 在第2列的位置
If IsNumeric(MH) Then '如比對成功傳回在比對的列數, 否則傳回錯誤訊息
'故先用 IsNumeric(MH) 判斷MH是否為數字
Cells(Target.Row, MH + 2) = 1 '若有符合，填入１
End If
End If
End Sub

複製代碼

作者: kasa 時間: 2015-12-24 21:16

謝謝各位前賢指導,我收下慢慢咀嚼,感謝~

作者: kasa 時間: 2015-12-24 23:09

針對"准提部林"前輩寫的程式,請幫忙指點以下,謝謝~
(1)在未特別寫出定義M變數屬性,是預設定義為integer嗎?
(2)請您指導以下寫這3行的真實對應含義(爬過文,但我認為我似懂非懂,所以想搞懂在何種狀況下,可同樣運用此寫法)
On Error GoTo 999  '發生錯誤時，執行標記９９９那行程式
Application.EnableEvents = False  '關閉事件觸發
999: Application.EnableEvents = True  '恢復事件觸發

(3)xR(1, 2)==>這個指的是? 我只會推論這寫法是以第一列第二行之儲存格為基準位置,然後有變動之所有儲存格為xR的話,這代表實際有變動值儲存格之位置
或者是因為上面有先寫:For Each xR In .Cells, 所以xR(1, 2)是指以第一列二行為基準位置,然後固定第二行視xR在第幾列位置來代表實際有變動值儲存格之位置

作者: 准提部林 時間: 2015-12-25 10:03

本帖最後由准提部林於 2015-12-25 18:50 編輯

回復 10# kasa

1)在未特別寫出定義M變數屬性,是預設定義為integer嗎?　
＿因MATCH會產生〔整數〕及找不到時〔#N/A]，所以，M不可事先定義(預設為Variant)，否則程式會錯誤而中斷！　
　其後才有　If IsNumeric(M) Then　作判斷！　

(2)請您指導以下寫這3行的真實對應含義　
On Error GoTo 999 '發生錯誤時，執行標記９９９那行程式
＿因下一行為〔關閉事件觸發〕，若在〔主處理段〕發生錯誤中斷，程式即跑不到〔恢復事件觸發〕那一行，
　當〔取消〕程式的〔中斷〕提示後，所有的〔事件觸發〕即失效無法運作！　
　（註：因主處理段有對工作表做 Change 的動作，為免〔連鎖反應〕，應先關閉。）　
　Application.EnableEvents = False　'關閉事件觸發
　～～主處理段～～
999: Application.EnableEvents = True '恢復事件觸發　

(3)xR(1, 2)==>這個指的是?
＿For Each xR In .Cells
　若將資料貼在[B3:B6]，則 xR 依次為 B3.B4.B5.B6，
　以 B3 為例，xR(1, 2) 等同 xR.Cells(1, 2)，亦即為其〔右一格〕 C3，
　xR(1, 2).Resize(1, 99).ClearContents　即以C3為始，向右取９９格清除　

作者: kasa 時間: 2015-12-25 11:44

太謝謝了,清楚很多了

M = Application.Match(xR, [2:2], 0)　'找出Item在第２列的位置
再請問,如果只要單純找出Item在G2到M2的位置,用以下寫法卻失敗,該如何修正才對? 謝謝.
M = Application.Match(xR, Range("G2:M2"), 0)

作者: kasa 時間: 2015-12-25 12:45

不好意思,我找到方法了,感謝前賢的大方指導,豁然開朗多了~~~~~

Set rng2 = [AH1:BQ1]
M = Application.Match(xR, rng2, 0)

作者: 千暉尋 時間: 2015-12-25 18:04

回復 10# kasa
謝謝大大的提問 ,我也對這些語句似懂非懂,現在有解答了.

作者: URCHEN 時間: 2015-12-25 21:25

感謝准堤大的解說，我也看懂了~

作者: kasa 時間: 2015-12-26 09:34

抱歉再提問以下,感謝~
以 B3 為例，xR(1, 2) 等同 xR.Cells(1, 2)，亦即為其〔右一格〕 C3
=>以 B3 為例，若改成xR(1, 1) 等同 xR.Cells(1, 1)，亦即仍為B3,我這樣理解是對的嗎?

作者: 准提部林 時間: 2015-12-26 13:17

回復 16# kasa

[B3].cells(1,1)
[B3].offset(0,0)
都是[B3]本尊

作者: kasa 時間: 2015-12-28 15:53

本帖最後由 kasa 於 2015-12-28 15:55 編輯

再請教若需"同時"去"貼入"資料於B/C欄之"屬性"與"細目"欄位中,
其他項目仍皆依"屬性"來比對出第二列之欄位並在所屬同列填入"1",但只有屬性C需依"細目"之C1/C2比對出第二列之欄位並在所屬同列填入"1"
如果仍要寫在Worksheet_Change內,是否有可能達成? 我爬文暫找不到可以同時存在兩種不同target的方法
再請前輩幫忙指導,感謝~
[attach]23000[/attach]

[attach]23002[/attach]

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