12
返回列表 上一主題 發帖

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

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-12-23 15:23 | 只看該作者

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

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

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

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-24 

熱烈參與勳章
2#
發表於 2015-12-23 19:03 | 只看該作者
C3=IF(C$2=$B3,1,"")

TOP

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
3#
發表於 2015-12-23 22:00 | 只看該作者
我試著寫出以下巨集,結果是成功的,因我還屬自學的初心者
故有以下需請教各位前賢,請不吝指教,謝謝.
(1)是否有更好的寫法?
(2)如果B3~B14欄位原保持空白,要寫成當一key入代碼時,可自動變換對應欄位顯示"1",該如何運用worksheet_change語法加入此段巨集
要以如此寫法的用意是:就不用再額外有執行巨集的動作了
Book2.rar (12.73 KB)

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

TOP

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
4#
發表於 2015-12-23 22:09 | 只看該作者
搜索了worksheet_change語法,還是不太懂如何運用

TOP

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
5#
發表於 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

TOP

URCHEN

帖子
4 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
windows7 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2015-8-13 
最後登錄
2020-6-26 
6#
發表於 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沒多久，如果有錯，還請各位大大包涵~

TOP

准提部林

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

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
8#
發表於 2015-12-24 15:43 | 只看該作者
試試看:
  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
複製代碼

TOP

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
9#
發表於 2015-12-24 21:16 | 只看該作者
謝謝各位前賢指導,我收下慢慢咀嚼,感謝~

TOP

kasa

帖子
20 
主題
5 
精華
0 
積分
63 
點名
0  
作業系統
WINXP 
軟體版本
OFFICE 2007 
閱讀權限
20 
註冊時間
2014-11-21 
最後登錄
2023-2-9 
10#
發表於 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在第幾列位置來代表實際有變動值儲存格之位置

TOP

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
12
返回列表 上一主題