![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
No.2ベストアンサー
- 回答日時:
Option Explicit
Private Const lngNoCol As Long = 2
Private Const lngHinNameCol As Long = 3
Private Const lngOkurisakiCol As Long = 4
Private Const lngSyubetsuCol As Long = 5
Private Const lngSyukkaCol As Long = 6
Private Const lngNounyudayCol As Long = 7
Private Const strSheetName As String = "Sheet1"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objWorkbook As Workbook
Dim objWorkSheet As Worksheet
Dim objDaySheet As Worksheet
Dim objRange As Range
Dim lngStartRow As Long
Dim lngMaxRow As Long
Dim lngRow As Long
Dim lngCol As Long
If (Target.Column > 2 Or Target.Column < 2 Or Target.Row > 1) Then
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set objWorkbook = Workbooks(ThisWorkbook.Name)
Set objWorkSheet = objWorkbook.Sheets(strSheetName)
With objWorkSheet
For Each objDaySheet In Worksheets
If objDaySheet.Name = Mid(.Cells(1, 2), 1, 4) & Mid(.Cells(1, 2), 6, 2) & Mid(.Cells(1, 2), 9, 2) Then
MsgBox "すでにシートがあります。"
GoTo ExitProc
End If
Next objDaySheet
End With
lngMaxRow = objWorkSheet.Cells(Rows.Count, lngNounyudayCol).End(xlUp).Row
Set objRange = Range(objWorkSheet.Cells(4, lngNounyudayCol), objWorkSheet.Cells(lngMaxRow, lngNounyudayCol)).Find(What:=objWorkSheet.Cells(1, 2))
If Not objRange Is Nothing Then
objWorkbook.Sheets.Add After:=objWorkbook.Worksheets(objWorkbook.Worksheets.Count)
With objWorkSheet
objWorkbook.ActiveSheet.Name = Mid(.Cells(1, 2), 1, 4) & Mid(.Cells(1, 2), 6, 2) & Mid(.Cells(1, 2), 9, 2)
Set objDaySheet = objWorkbook.Sheets(Mid(.Cells(1, 2), 1, 4) & Mid(.Cells(1, 2), 6, 2) & Mid(.Cells(1, 2), 9, 2))
End With
For lngCol = lngNoCol To lngNounyudayCol
objDaySheet.Cells(1, lngCol - 1).Value = objWorkSheet.Cells(3, lngCol)
Next lngCol
lngStartRow = 4
lngRow = 2
Do While objWorkSheet.Cells(lngStartRow, lngNounyudayCol) <> ""
If objWorkSheet.Cells(lngStartRow, lngNounyudayCol) = objWorkSheet.Cells(1, 2) Then
With objDaySheet
.Cells(lngRow, lngNoCol - 1) = objWorkSheet.Cells(lngStartRow, lngNoCol)
.Cells(lngRow, lngHinNameCol - 1) = objWorkSheet.Cells(lngStartRow, lngHinNameCol)
.Cells(lngRow, lngOkurisakiCol - 1) = objWorkSheet.Cells(lngStartRow, lngOkurisakiCol)
.Cells(lngRow, lngSyubetsuCol - 1) = objWorkSheet.Cells(lngStartRow, lngSyubetsuCol)
.Cells(lngRow, lngSyukkaCol - 1) = objWorkSheet.Cells(lngStartRow, lngSyukkaCol)
.Cells(lngRow, lngNounyudayCol - 1) = objWorkSheet.Cells(lngStartRow, lngNounyudayCol)
.Cells(lngRow, lngNounyudayCol - 1).NumberFormatLocal = "yyyy/mm/dd"
End With
lngRow = lngRow + 1
End If
lngStartRow = lngStartRow + 1
Loop
Else
MsgBox "日付がありませんでした。"
GoTo ExitProc
End If
ExitProc:
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
こんな感じでどうでしょうか?
日付けを変更するとその日付けのシートを作成しそのデータのみを日付シートに書き込みます。
No.3
- 回答日時:
勝手に質問を解釈してお答えします。
(一応、マクロ案です)データのシート(Sheet1)
A B C E F G
1 NO 品名 送り先 種別 出荷 納品日
2
と一行目に項目を入れて、二行目以下にデータを入れる形にします。
抽出のシート(Sheet2)
A B C E F G
1 納品日
2
3 NO 品名 送り先 種別 出荷 納品日
と、A1セルに抽出したい項目、A2セルに 抽出する日付を入れるとします。
3行目に、更に項目名を入れておきます。
Sheet2の名前のタブを右クリック、コードの表示をクリックして
VBエディターが起動したら
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Sheets("Sheet1").Columns("A:G").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A3:G3"), Unique:=False
End If
End Sub
を張り付けて、VBエディターを閉じる。
Sheets2のA2セルに日付を入れると
納入日が、その日付のデータだけが4行目以下に表示されます。
このマクロは、フィルターオプションをマクロ化したものです。
参考までに、納入日が日付順に並んでいれば、簡単な関数でも安納です。
提示してあるシートでも可能ですが、データは1行目に項目、2行目以下にデータを入力する事が鉄則と思ってください。
あくまでも出荷日=納入日 として考えました。
No.1
- 回答日時:
https://oshiete.goo.ne.jp/qa/9111023.html
マクロにしても関数にしても、結果をどのようにしたいかが示されていません
題目は抽出ですが
>日付順に別シート(Sheet2)へデータを抽出することはできませんか?
「日付順」ということは並べ替えです。どちらでしょう?
また、抽出だとして 納入日=出荷日のみを抽出するのでしょうか?
(トリガ)条件の質問文がわかりにくいです
>Sheet1の画像の表のB1に日付を入力してくださいした際に
InputBox("日付を入力してください")
のようにメッセージを出せってことかなぁ
マクロにしても関数にしても、結果をどのようにしたいかが示されていません
題目は抽出ですが
>日付順に別シート(Sheet2)へデータを抽出することはできませんか?
「日付順」ということは並べ替えです。どちらでしょう?
また、抽出だとして 納入日=出荷日のみを抽出するのでしょうか?
(トリガ)条件の質問文がわかりにくいです
>Sheet1の画像の表のB1に日付を入力してくださいした際に
InputBox("日付を入力してください")
のようにメッセージを出せってことかなぁ
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excel 売上管理シートに入力した売上データを、日報に自動反映させたいと考えています。 売上管理シ 3 2023/04/29 18:08
- Excel(エクセル) Excelで日報を自動で作成したい 売上管理シートに入力した売上データを、日報に自動反映させたいと考 1 2023/04/29 18:07
- Excel(エクセル) 【Excel質問】別シートにある複数の同型の表から、同じ行項目にある数字を集計する 4 2023/02/16 00:14
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) 複数セルデータを別シートの単一セルにコピーしたい。(詳細をご参照ください) 1 2022/12/14 15:08
- Excel(エクセル) Excelマクロの差分抽出のコードを教えていただきたいです。 2 2023/03/14 11:40
- Excel(エクセル) Excelでのデータ管理 6 2022/12/24 09:33
- Excel(エクセル) 【エクセル」 特定のセルで条件抽出した列を、別シートに上から詰めて表示したい。 8 2022/04/08 16:00
- その他(Microsoft Office) 従業員増減対応で当番種類の増減対応な当番表 21 2022/07/19 07:30
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel関数-文字列で自動作成さ...
-
エクセルの関数について教えて...
-
Excelデータをコピペして、ペー...
-
職場の人から聞かれており、こ...
-
ユーザー定義関数をアドイン登...
-
Excelで50個のセルに同じ文字を...
-
スプレッドシート、Excelでの数...
-
Microsoft Officeの中古は信用...
-
エクセルで不等号記号(≠)が上に...
-
スプレッドシートで使う数式を...
-
エクセルでの特別な文字を上に...
-
エクセル日付 文字列の関数がエ...
-
A列とB列を参照してC列に連番を...
-
エクセルVBA、別ブックへ転記す...
-
各ページの1番上の表示について
-
エクセルでセルに標準で入力さ...
-
EXCELの質問です 119から足した...
-
pdfの表をexcelにはりつけて計...
-
Excelのif関数で文字が見えなく...
-
【マクロ】アクティブセルにブ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA、別ブックへ転記す...
-
エクセルでの作業計算方法について
-
時間によってファイル名が変わ...
-
【関数】適切な文字数の数字を...
-
Excelについて教えてください
-
エクセル初心者です 関数の入れ...
-
【マクロ】ファイル名の変更に...
-
UNIQUE関数が使えないバージョ...
-
エクセルの計算
-
【関数】先頭だけにある、半角...
-
Excelで、決まった行を繰り返し...
-
Excelでセルの値が同じか...
-
LOOKUP関数を使えばいいのでし...
-
Excel
-
はがきについて。
-
エクセルの条件付き書式につい...
-
エクセルのデーターが2か月前の...
-
エクセル②
-
エクセルで「-0.0」と表示さ...
-
Microsoft1Officeの互換ソフト...
おすすめ情報
すみません!
日付順でなくてOKです。
Sheet1のB1に日付を入力、もしくはボタンをつけてクリックしたら
B1=納入日の行をSheet2に抽出したいです。。