| |
▼yayoi さん：
相変わらず、エラー処理はしていません。
Sheet2に
B 田中 C 近藤 X 松田
B 伊藤
B 齊藤
てな感じで、A1から入力されているとして、
列位置を入力した場合は、必ず名前を入力してください。
空白を希望なら、スペースを入力してください。
列番は、アルファベットで、必ず順番に並べて入力してください。
OnTimeは使っていないので、下記コードは、Sheet1にコピーしてください。
セルの選択の変更で処理されます。
ウィンドウの固定をA列でしといてね。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rg As Variant
Dim Clm As Long
Dim i As Long
Dim j As Long
Dim ChangeClm As Long
rg = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion.Value
Clm = ThisWorkbook.Windows(1).Panes(2).VisibleRange.Cells(1).Column
Application.ScreenUpdating = False
For i = LBound(rg, 1) To UBound(rg, 1)
For j = LBound(rg, 2) To UBound(rg, 2) Step 2
If rg(i, j) <> "" Then
ChangeClm = Range(rg(i, j) & 1).Column
If ChangeClm <= Clm Then
Range("A" & i) = rg(i, j + 1)
Else
Exit For
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
