[發問] 垂直欄位項目轉至水平列顯示

kasa

請教各位大大,
如何讓附件各編號key in之Item可於第二列水平展開所對應之Item顯示"1"
例如:於編號3之B欄key 入"D1"後,而同步可讓"F5"儲存格顯示"1"
Book2.rar (7.07 KB)

下載次數: 8

2015-12-23 15:20

下載 (75.3 KB)

2015-12-23 15:22

hcm19522

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

kasa

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

下載次數: 4

2015-12-23 22:00

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

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

kasa

嘗試用以下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

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

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沒多久，如果有錯，還請各位大大包涵~

准提部林

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

試試看:

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

複製代碼

kasa

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

kasa

針對"准提部林"前輩寫的程式,請幫忙指點以下,謝謝~
(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在第幾列位置來代表實際有變動值儲存格之位置