質問編集履歴
1
実際に使用したマクロの追記(ほぼほぼサイトからの引用です）
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -42,5 +42,83 @@
|
|
|
42
42
|
シート内から特定条件を指定して別シートに抽出する
|
|
43
43
|
（結局意味ありませんでした）
|
|
44
44
|
|
|
45
|
+
追記：使用したマクロがあった方が良いとアドバイスをいただきましたので、下記に示します。
|
|
45
46
|
|
|
46
|
-
|
|
47
|
+
①シート名が違いますが、別データで試したため気にしないでください。
|
|
48
|
+
こちらは単純に前月と当月で片方に居ない人を抽出するマクロとして改変して作りました。
|
|
49
|
+
(ttps://excel.kuuneruch.com/sabun-extra/)
|
|
50
|
+
|
|
51
|
+
Public Sub MainProc()
|
|
52
|
+
Dim shtMain As Worksheet
|
|
53
|
+
Dim motoName As String
|
|
54
|
+
Dim sakiName As String
|
|
55
|
+
Dim shtMoto As Worksheet
|
|
56
|
+
Dim shtSaki As Worksheet
|
|
57
|
+
Dim shtSabun As Worksheet
|
|
58
|
+
Dim lastRowMoto As Long
|
|
59
|
+
Dim lastRowSaki As Long
|
|
60
|
+
Dim lastCol As Long
|
|
61
|
+
Dim i As Long
|
|
62
|
+
Dim j As Long
|
|
63
|
+
Dim k As Long
|
|
64
|
+
Dim blnSame As Boolean
|
|
65
|
+
Dim blnExist As Boolean
|
|
66
|
+
Dim nowRow As Long
|
|
67
|
+
|
|
68
|
+
Set shtMain = ThisWorkbook.Sheets("メイン")
|
|
69
|
+
motoName = shtMain.Range("A2")
|
|
70
|
+
sakiName = shtMain.Range("B2")
|
|
71
|
+
Set shtMoto = ThisWorkbook.Sheets(motoName)
|
|
72
|
+
Set shtSaki = ThisWorkbook.Sheets(sakiName)
|
|
73
|
+
Set shtSabun = ThisWorkbook.Sheets("比較")
|
|
74
|
+
lastRowMoto = shtMoto.Cells(shtMoto.Rows.Count, 1).End(xlUp).Row
|
|
75
|
+
lastCol = shtMoto.Cells(1, shtMoto.Columns.Count).End(xlToLeft).Column
|
|
76
|
+
lastRowSaki = shtSaki.Cells(shtSaki.Rows.Count, 1).End(xlUp).Row
|
|
77
|
+
shtSabun.Cells.Clear
|
|
78
|
+
shtMoto.Range(shtMoto.Cells(1, 1), shtMoto.Cells(1, lastCol)).Copy (shtSabun.Cells(1, 1))
|
|
79
|
+
nowRow = 1
|
|
80
|
+
For i = 2 To lastRowMoto
|
|
81
|
+
blnExist = False
|
|
82
|
+
For j = 2 To lastRowSaki
|
|
83
|
+
blnSame = True
|
|
84
|
+
For k = 1 To lastCol
|
|
85
|
+
If shtMoto.Cells(i, k) <> shtSaki.Cells(j, k) Then
|
|
86
|
+
blnSame = False
|
|
87
|
+
Exit For
|
|
88
|
+
End If
|
|
89
|
+
Next
|
|
90
|
+
If blnSame = True Then
|
|
91
|
+
blnExist = True
|
|
92
|
+
Exit For
|
|
93
|
+
End If
|
|
94
|
+
Next
|
|
95
|
+
If blnExist = False Then
|
|
96
|
+
nowRow = nowRow + 1
|
|
97
|
+
shtMoto.Range(shtMoto.Cells(i, 1), shtMoto.Cells(i, lastCol)).Copy (shtSabun.Cells(nowRow, 1))
|
|
98
|
+
End If
|
|
99
|
+
Next
|
|
100
|
+
MsgBox "完了"
|
|
101
|
+
End Sub
|
|
102
|
+
|
|
103
|
+
②こちらは参考にして作ったのですが、うまく出来ずに丸ごと消してしまったためもともと参考にしていたサイトの物を載せます。
|
|
104
|
+
(ttp://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/prog/prog04.html)
|
|
105
|
+
|
|
106
|
+
Sub prog4_1()
|
|
107
|
+
Dim myFld As String, myCri As String
|
|
108
|
+
Dim myRow As Long
|
|
109
|
+
myFld = InputBox("検索は何列目ですか?")
|
|
110
|
+
myCri = InputBox("検索する語句を入力しなさい")
|
|
111
|
+
'オートフィルタでデータを抽出する
|
|
112
|
+
Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
|
|
113
|
+
’抽出データの最終行を求める
|
|
114
|
+
myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
|
|
115
|
+
'抽出先をクリアする
|
|
116
|
+
Worksheets("抽出").Range("A:E").ClearContents
|
|
117
|
+
'抽出データをコピーして貼り付け
|
|
118
|
+
Worksheets("データ").Range("A1:E" & myRow).Copy Worksheets("抽出").Range("A1")
|
|
119
|
+
'オートフィルタを解除
|
|
120
|
+
Worksheets("データ").Range("A1").AutoFilter
|
|
121
|
+
'抽出先シートをアクティブにしてA1セルを選択する
|
|
122
|
+
Worksheets("抽出").Activate
|
|
123
|
+
Range("A1").Select
|
|
124
|
+
End Sub
|