\u5168\u30b7\u30fc\u30c8\u3092\u5bfe\u8c61\u306b\u5024\u304c\u542b\u307e\u308c\u308b\u884c\u3092\u30b3\u30d4\u30fc<\/p>\n
Sub Initialize()\r\n \r\nApplication.ScreenUpdating = False\r\nApplication.EnableEvents = False\r\nApplication.DisplayAlerts = False\r\nApplication.Calculation = xlCalculationManual ' \u95a2\u6570\u5229\u7528\u6ce8\u610f\r\n\r\nEnd Sub\r\n \r\nSub Finalize()\r\n\r\nApplication.Calculation = xlCalculationAutomatic\r\nApplication.DisplayAlerts = True\r\nApplication.EnableEvents = True\r\nApplication.ScreenUpdating = True\r\n \r\nEnd Sub\r\n\r\nSub test1()\r\n\r\nInitialize\r\n\r\n'\u66f8\u304d\u8fbc\u307f\u30b7\u30fc\u30c8\u540d\r\nwriteSheet = \"\u5de5\u756a\u96c6\u8a08\"\r\n\r\n' 1: 10\u5217\u76ee\u306b\u5bfe\u8c61\u3092\u542b\u3080\u304b, 2: 11\u5217\u76ee\u304c\u65e5\u4ed8\u3068\u3057\u3066\u5bfe\u8c61\u3068\u4e00\u81f4\u3059\u308b\u304b\u3002\r\nifValue = 2\r\n\r\n' \u6700\u7d42\u884c\u304c1\u4e07\u3088\u308a\u591a\u3044\u5834\u5408\u7d42\u4e86\r\n\r\nFor Each w In Sheets\r\n If w.Cells.SpecialCells(xlLastCell).Row > 10000 Then\r\n MsgBox w.Name & \"\u306e\u884c\u6570\u304c\u591a\u3044\u305f\u3081\u7d42\u4e86\u3057\u307e\u3059\"\r\n Exit Sub\r\n End If\r\nNext w\r\n\r\n' \u691c\u7d22\u6587\u5b57\u5217\u5165\u529b\r\n\r\nnm = InputBox(\"\u5024\u3092\u5165\u529b\u3057\u3066\u304f\u3060\u3055\u3044\")\r\nIf nm = \"\" Then Exit Sub\r\nIf ifValue = 2 And False = IsDate(nm) Then Exit Sub\r\n\r\n' \u66f8\u304d\u8fbc\u307f\u30b7\u30fc\u30c8\u6e96\u5099\r\n\r\nFor Each w In Sheets\r\n If w.Name = writeSheet Then\r\n w.Delete\r\n Exit For\r\n End If\r\nNext w\r\n\r\nSheets.Add After:=Sheets(1)\r\nActiveSheet.Name = writeSheet\r\n\r\ncurrentRowNumber = 1\r\n\r\n' \u63a2\u7d22\u51e6\u7406\r\n\r\nDim rg As Range\r\nFor Each w In Sheets\r\n\r\n bt = w.Cells.SpecialCells(xlLastCell).Row\r\n If bt <= 1 Then GoTo continue:\r\n Set rg = w.Range(\"A1:AA\" & bt)\r\n \r\n For r = 1 To rg.Rows.Count\r\n \r\n Select Case ifValue\r\n \r\n Case 1\r\n \r\n If InStr(rg.Cells(r, 10).Value, nm) > 0 Then\r\n Sheets(writeSheet).Range(\"A\" & currentRowNumber & \":AA\" & currentRowNumber).Value = rg.Range(\"A\" & r & \":AA\" & r).Value\r\n currentRowNumber = currentRowNumber + 1\r\n End If\r\n \r\n Case 2\r\n \r\n If IsDate(rg.Cells(r, 11).Value) Then ' \u65e5\u4ed8\u306b\u5909\u63db\u53ef\u80fd\r\n If CDate(rg.Cells(r, 11).Value) = CDate(nm) Then\r\n Sheets(writeSheet).Range(\"A\" & currentRowNumber & \":AA\" & currentRowNumber).Value = rg.Range(\"A\" & r & \":AA\" & r).Value\r\n currentRowNumber = currentRowNumber + 1\r\n End If\r\n End If\r\n \r\n End Select\r\n\r\n Next\r\n \r\ncontinue:\r\nNext w\r\n\r\nSheets(writeSheet).Activate\r\nSheets(writeSheet).Columns.AutoFit\r\n\r\nFinalize\r\n\r\nEnd Sub<\/pre>\n<\/p>\n","protected":false},"excerpt":{"rendered":"
\u5168\u30b7\u30fc\u30c8\u3092\u5bfe\u8c61\u306b\u5024\u304c\u542b\u307e\u308c\u308b\u884c\u3092\u30b3\u30d4\u30fc Sub Initialize() Application.ScreenUpdating = False Application.EnableEvents = False Appli … <\/p>\n