| |
▼daikonsan さん：
こんな感じで。下のセル値が小さいかどうかで判定
Sub test()
Dim ws As Worksheet, a
Dim r As Range, c As Range
Dim k As Long
Set ws = Workbooks("Book1.xlsx").Worksheets("Sheet1")
With ws.Range("A4", ws.Cells(Rows.Count, 1).End(xlUp))
a = Split(WorksheetFunction.TextJoin(" ", True, .Cells))
End With
Set r = Range("F4", Cells(Rows.Count, 6).End(xlUp))
k = 0
For Each c In r
c.Offset(, -1).Value = a(k)
If c.Value > c.Offset(1).Value Then k = k + 1
Next
End Sub
前の質問の続きで
IDの種類だけ日付コピーするなら
Sub test2()
Dim ws As Worksheet, a
Dim r As Range, v
Dim n As Long
Dim k As Long
Set ws = Workbooks("Book1.xlsx").Worksheets("Sheet1")
With ws.Range("A4", ws.Cells(Rows.Count, 1).End(xlUp))
a = Split(WorksheetFunction.TextJoin(" ", True, .Cells))
End With
Set r = Range("F2", Cells(Rows.Count, 6).End(xlUp))
v = r.Value
n = UBound(v)
For k = 0 To UBound(a)
r.Offset(k * n, -1).Value = a(k)
r.Offset(k * n).Value = v
Next
End Sub
日付もマクロで入力するなら
Sub test3()
Dim ws As Worksheet, a
Dim y As Long, m As Long
Dim d1 As Long, d2 As Long
Dim v, n As Long
Dim k As Long
Dim r As Range
Set ws = Workbooks("Book1.xlsx").Worksheets("Sheet1")
With ws.Range("A4", ws.Cells(Rows.Count, 1).End(xlUp))
a = Split(WorksheetFunction.TextJoin(" ", True, .Cells))
End With
y = 2022
m = 2
d1 = CLng(DateSerial(y, m, 1))
d2 = CLng(DateSerial(y, m + 1, 0))
v = Evaluate("row(" & d1 & ":" & d2 & ")")
n = UBound(v)
For k = 0 To UBound(a)
Set r = Range("F2").Resize(n).Offset(k * n)
r.Offset(, -1).Value = a(k)
r.Value = v
Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
