| |
上手く行かなかったらゴメン
疑問に思うのは、
>same，different列には何も記載しない(スペース)と追加したいのです。
スペースを入れる事と、何もし無い事とは違うんですけど？
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim vntResult As Variant
Dim vntStep As Variant
Dim strProm As String
vntStep = Application.InputBox("比較する試行前入力", , , , , , , 1)
If VarType(vntStep) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'Listの左上隅を基準とする（列見出しがある物とします）
Set rngList = ActiveSheet.Cells(1, "A")
With rngList
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
If lngRows <= 1 Then
strProm = "データが有りません"
GoTo Wayout
End If
'項目1、項目2を配列に取得
vntData = .Offset(1, 1).Resize(lngRows, 2).Value
End With
'結果用配列を確保
ReDim vntResult(1 To lngRows, 1 To 2)
For i = 1 To lngRows - vntStep
'項目2がスペースの試行で無ければ
If Trim(vntData(i, 2)) <> "" Then
'ｎ試行前がA，Bでなくスペースで無ければ
If Trim(vntData(i + vntStep, 2)) <> "" Then
'項目2において，n試行前と比較し，同じであれば
If vntData(i, 2) = vntData(i + vntStep, 2) Then
vntResult(i, 1) = vntData(i, 1)
Else
vntResult(i, 2) = vntData(i, 1)
End If
' Else
' 'スペースを入れる
' vntResult(i, 2) = " "
End If
' Else
' 'スペースを入れる
' vntResult(i, 1) = " "
End If
Next i
Application.ScreenUpdating = False
'結果を出力
rngList.Offset(1, 3).Resize(lngRows, 2).Value = vntResult
Application.ScreenUpdating = True
strProm = "処理が完了しました"
Wayout:
Set rngList = Nothing
Beep
MsgBox strProm
End Sub
|
|
Hirofumi
- 05/10/8(土) 20:53 -
