ç¾å¨ã¢ã¯ãã£ããªããã¯ã®ã·ã¼ãã«ãè¤æ°ããã¯ã®ãã¼ã¿ãæ¿å ¥è²¼ãä»ããã
ä»åã¯ããã¯ãã使ãå§ãã人ãã¾ãæåã«ãã£ã¦ã¿ãããªãã¨ãããã£ã¦ã¿ãããã¨æãã¾ãã
ãããããã¨ã¯åç´ã«ä¸è¨ã®ãããªãã¨ã
a.xlsxãb.xlsxãc.xlsxãd.xlsxã・・・・・・z.xlsxã®ããã«è¡æ°ãä¸å®ãªè¤æ°ããã¯ãããã
Â
ãããã®ãã¼ã¿ããa.xlsxã®ãã¼ã¿ç¾¤ã®ä¸å´ã«æ¿å ¥è²¼ãä»ãããã¦ããã¨ãããã®ã§ããï¼è²¼ãä»ããããå´ã®ããã¯ã¯ãb.xlsxãc.xlsx・・・・・・ã§ãã£ã¦ãããï¼
Â
ä»åã®ãã¯ãã®ä¸èº«ããã£ããã¨èª¬æããã¨ãApplication.GetOpenFilenameã¨ããã¡ã½ããã§ããã¡ã¤ã«é¸æã®ããã®ãã¤ã¢ãã°ããã¯ã¹ãéããããã¯ãé¸æãã¾ãï¼ããã¯ã¯è¤æ°é¸æå¯è½ã§ãï¼ã
ããã§ã¯ãa.xlsxã«ãã¼ã¹ãããã®ã§ãa.xlsxãé¤ãããb.xlsxï½z.xlsxãé¸æãï¼a.xlsxã¯éããç¶æ
ã«ãã¦ããï¼
ããã§é¸æãããããã¯ã®ããã¯åï¼ãã¹ãå«ãã FullNameï¼ãé
åã«æ ¼ç´ããããããé
åã®å
容ãFor Eachãï½Nextã§é 次èªã¿åã
- åå¾ããããã¯åãç¨ãã¦ããã¯ãéã
- ããã¯ãéããæã«ã¢ã¯ãã£ããªã·ã¼ãã®ãã¼ã¿ãã³ãã¼
- è²¼ãä»ããããå´ã®ããã¯ã®ãã¼ã¿ç¾¤ã®ï¼è¡ä¸ã«ã¤ã³ãµã¼ã
- éããããã¯ãå¤æ´ããã«éãã
ã¨ããã«ã¼ãå¦çãè¡ãã¾ãã
ã³ãã¼ãéå§ããããã®å§ç¹ã¨ãªãè¡ã¯ã¦ã¼ã¶ã¼ãæå®ããå¿
è¦ãããã¾ãããçµç¹ã¨ãªãè¡ã¯ããã°ã©ã ãèªåå¤å¥ãã¾ãã
ãªã®ã§ãè¡æ°ã¯ä¸å®ã§ãã£ã¦ããè¦åºãã®ä½ç½®ãå
容ãåã®æ°ãªã©ã¯åæ§ãªãã¼ã¿ã®é£çµãæ³å®ãã¦ãã¾ããï¼ãããããæ§å¼ã®ç°ãªãè³æãé£çµãã¦ãæå³ãªãã§ãããï¼
ãã®ä»ã¯ãä¸å ·åé²æ¢ã®ããã®å¦çãªã©ãããããã¨ä¸¦ãã§ãã¾ããÂ
Sub ç¾å¨ã¢ã¯ãã£ããªããã¯ã«è¤æ°ããã¯ã®ãã¼ã¿ãæ¿å ¥è²¼ãä»ã() 'ç¾å¨ã¢ã¯ãã£ããªããã¯ã®ãã¼ã¿ç¾¤ã®ï¼è¡ä¸ã«ãé¸æãããããã¯ã®ãã¼ã¿ããé çªã«æ¿å ¥è²¼ãä»ããã¦ããã¾ãã '対象ã¨ãªãã®ã¯ã*.xlsxã*.xlsmãã*.csvçã®ã¨ã¯ã»ã«ã§æ±ããã¨ã®ã§ãããã¡ã¤ã«ã§ãã 'ãã¼ã¹ããããããã¯ï¼ç¾å¨ã¢ã¯ãã£ããªããã¯ï¼ä»¥å¤ã¯éããç¶æ ã§å®è¡ãã¦ä¸ããã 'ã³ãã¼ããããã¯ã¯ããã¼ã¹ããããå´ã®ããã¯ã¨åãæ§å¼ã§ãããã¨ãæ³å®ãã¦ãã¾ãã Dim awn As String Dim Bcdrive As String Dim Bcdir As String Dim lwfn As Variant Dim ctm As Integer Dim yr As Range Dim nod As Variant Dim anod As Long Dim y As Long Dim x As Integer Dim myWb As Variant Dim i As Integer Dim cts1 As Integer Dim lwn As String Dim myLis As ListObject Dim lye As Long Dim aye As Long Dim cts2 As Integer Dim ct As Integer awn = ActiveWorkbook.Name If Not awn Like "*.*" Then MsgBox "æ°è¦ããã¯ä¸ã§ã¯å®è¡ã§ãã¾ããã" Exit Sub End If Bcdrive = Left(CurDir, InStr(CurDir, ":") - 1) 'ç¾å¨ã®ã«ã¬ã³ããã©ã¤ããè¨æ¶ Bcdir = CurDir 'ç¾å¨ã®ã«ã¬ã³ããã£ã¬ã¯ããªãè¨æ¶ ChDrive Left(ActiveWorkbook.Path, InStr(ActiveWorkbook.Path, ":") - 1) 'ã«ã¬ã³ããã©ã¤ããä¸æçã«å¤æ´ ChDir ActiveWorkbook.Path 'ã«ã¬ã³ããã£ã¬ã¯ããªãä¸æçã«å¤æ´ lwfn = Application.GetOpenFilename(Title:="ã³ãã¼ããããã¯ãé¸æï¼è¤æ°é¸æå¯ï¼", MultiSelect:=True) If TypeName(lwfn) = "Boolean" Then 'ãã£ã³ã»ã«ãæ¼ãããå ´åã®å¦ç ChDrive Bcdrive ChDir Bcdir Exit Sub End If ctm = UBound(lwfn) retry1: On Error Resume Next Set yr = Nothing 'retryããæã®ããã®ãªã»ãã Set yr = Application.InputBox(Prompt:="ã³ãã¼ã®å§ç¹ã¨ãªãè¡ã®ã»ã«ãé¸æããOKãã¦ä¸ããã" & vbCrLf & "ï¼è¦åºãã®1è¡ä¸ãæ¨å¥¨ï¼", Type:=8) If yr Is Nothing Then 'ãã£ã³ã»ã«ãæ¼ãããå ´åã®å¦ç ChDrive Bcdrive ChDir Bcdir Exit Sub ElseIf yr.Resize(1, 1).Value = "" Then 'è¤æ°ç¯å²ãé¸æãããå ´åãæ³å®ãã¦ãResizeãé©ç¨ãã MsgBox "空ç½ä»¥å¤ã®ã»ã«ãé¸æãã¦ãã ããã" GoTo retry1 End If On Error GoTo 0 retry2: nod = Application.InputBox(Prompt:="è¡Ãå ã«å«ã¾ãããæ大ãã¼ã¿æ°ãæå®ãã¦ä¸ããã" & vbCrLf & _ "ã»ã³ãã¼ããããã¯ããã®å¤ãè¶ ããå ´åãå¦çãã¹ããããã¾ãã" & vbCrLf & _ "ã»ããªã¼ãºé²æ¢çã§ããç°å¢ã«å¿ãã¦å¢æ¸ãã¦ä¸ããã", Default:="10000", Type:=1) If TypeName(nod) = "Boolean" Then 'ãã£ã³ã»ã«ãæ¼ãããå ´åã®å¦ç ChDrive Bcdrive ChDir Bcdir Exit Sub Else anod = WorksheetFunction.CountIf(Range("A1:XFD1048576"), "<>") If anod > nod Then MsgBox "ãã¼ã¹ããããå´ã®ããã¯ã«" & Format(nod, "#,###") & "ãè¶ ããã" & Format(anod, "#,###") & "ãã¼ã¿ãåå¨ãã¾ãã" _ & vbCrLf & vbCrLf & "ããªã¼ãºãé¿ããããã«ã軽éãªããã¯ä¸ã§å®è¡ãããã¨ãæ¨å¥¨ãã¾ãã" & vbCrLf & _ "ã³ãã¼ããå´ã®ããã¯ã§ã¯ããã«ã¡ã¢ãªãå¿ è¦ã¨ãã¾ãã®ã§ãå¿ è¦ã«å¿ãã" & vbCrLf & "æ大ãã¼ã¿æ°ãå¢æ¸ãã¦ä¸ããã" GoTo retry2 End If End If Application.ScreenUpdating = False 'ç»é¢è¡¨ç¤ºã®æ´æ°ããªãã«ãã y = yr.Row 'yrããè¡ãåå¾ x = yr.Column 'yrããåãåå¾ If Not ActiveSheet.AutoFilter Is Nothing Then '念ã®ããã®å¦çï¼ Cells(y, x).AutoFilter End If For Each myWb In lwfn For i = 1 To Workbooks.Count If Workbooks(i).FullName = myWb Then 'æ¢ã«éãã¦ããããã¯ã¯å¦çãã¹ããã If Not myWb Like "*" & awn Then 'ãã¼ã¹ããããããã¯ã¯ã¹ãããã«ã«ã¦ã³ãããªã cts1 = cts1 + 1 End If GoTo skip End If Next i Workbooks.Open Filename:=myWb 'ããã¯ãéãã¨åæã«ã¢ã¯ãã£ãã¨ãªã lwn = ActiveWorkbook.Name 'ãã¹ãå«ã¾ãªãããã¯åãåå¾ãã¦ãã If ActiveSheet.ListObjects.Count > 0 Then '念ã®ããã®å¦çï¼ For Each myLis In ActiveSheet.ListObjects myLis.Unlist Next myLis End If If Not ActiveSheet.AutoFilter Is Nothing Then 'éããããã¯ã®ã·ã¼ãã«ãªã¼ããã£ã«ã¿ã¼ãè¨å®ããã¦ããå ´åã¯è§£é¤ãã Cells(y, x).AutoFilter End If lye = Cells(y, x).CurrentRegion.Rows(Cells(y, x).CurrentRegion.Rows.Count).Row If WorksheetFunction.CountIf(Rows(y & ":" & lye), "<>") <= nod Then 'æå®ããæ大å¤ä»¥ä¸ã®å ´åã®ã¿å¦çãã Rows(y & ":" & lye).Copy Workbooks(awn).Activate aye = Cells(y, x).CurrentRegion.Rows(Cells(y, x).CurrentRegion.Rows.Count).Row Rows(aye + 1).Insert Workbooks(lwn).Application.CutCopyMode = False 'ã³ãã¼ã¢ã¼ãã解é¤ãã Else cts2 = cts2 + 1 End If Workbooks(lwn).Close savechanges:=False DoEvents 'Closeãå®äºããã¾ã§å¾ 㤠skip: ct = ct + 1 Application.StatusBar = "å¦çå®è¡ä¸ï¼ï¼ï¼" & ct & "/" & ctm Next myWb ChDrive Bcdrive ChDir Bcdir MsgBox "å¦çæåï¼" & ct - cts1 - cts2 & "/" & ctm & vbCrLf & "ã¹ãããï¼" & cts1 + cts2 & "ï¼Openéè¤ï¼" & cts1 & _ "ï¼æ大æ°è¶ éï¼" & cts2 & "ï¼" Application.StatusBar = False End Sub
Â
ãã®ãã¯ãã®åä½ç¢ºèªãããããã«ãè²ã
ãªããã¯ã使ã£ã¦ãã¹ããã¦ã¿ããã§ããããã¼ã¿ãã³ãã¼ããéã«ãã¼ã¿æ°ããã¾ãã«å¤ãã¨ããªã¼ãºãã¦ãã¾ãããã§ãã
ç§ã®ç°å¢ã§ã¯ç´35,000ãè¶
ãããã¼ã¿ï¼1,000è¡Ã35åã«ã³ã£ããã¨ãã¼ã¿ãè©°ã¾ã£ã¦ããæãï¼ãããåä½ãä¸å®å®ã«ãªãã®ã§ãç°å¢ã«ãã£ã¦åãæ±ãããã¼ã¿æ°ãå¢æ¸ã§ããããã«ãã¦ã¿ã¾ãããï¼ã¦ã¼ã¶ã¼ãæå®ãããã¼ã¿æ大æ°ãè¶
ãã¦ã³ãã¼ãããã¨ããã¨ãã³ãã¼ããã«æ¬¡ã®ããã¯ã«å¦çãé£ã°ãã¾ãï¼
æè¦çã«ãåããã¼ã¿æ°ã§ãã縦ã«é·ããã横ã«é·ãã»ããå¦çãæãããã«æãã¾ãã
ã³ãã¼ããå ´åã»ã©ã§ã¯ãªãã«ããããã¼ã¹ããããå´ã®ããã¯ï¼å¸¸æéããã¾ã¾ã«ãªãããã¯ï¼ã«ãã¼ã¿ãå¤ãå ´åããå¦çãéããªãããã«æããã®ã§ããããå
ã«æå®ããå¤ãè¶
ãããã¼ã¿ãå«ãããã¯ã§ãã£ãå ´åãå¦çã§ããªãï¼ãã¯ããå®è¡ã§ããªãï¼ããã«ãã¾ããã
ããªã¼ãºãé¿ããããã«ãããããããã«ãã¦ãã¾ãã¾ããããPCã®ã¹ããã¯ãé«ãã®ãªãã°æ大å¤ã2,147,483,647ï¼ç´46340è¡Ã46340åï¼ã¾ã§æ¡ãããã¨ãã§ããã®ã§ã¯ãªããã¨æãã¾ãã
Â
è£è¶³ï¼
- ããã¯ãå¦çããé çªã¯ããã¡ã¤ã«é¸æã®ãã¤ã¢ãã°ããã¯ã¹ã§é¸æããé ã§ã¯ãªãããã¤ã¢ãã°ããã¯ã¹ã§ã®è¡¨ç¤ºé ï¼ä¸ããï¼ã«ãªãã¾ãï¼è¦ããã«ä¸ããé çªã«é åã«æ ¼ç´ãããï¼ããªã®ã§ãé çªãå¤ãããå ´åã¯ããã¤ã¢ãã°ããã¯ã¹ã§å³ã¯ãªãã¯ããååé ã»æ´æ°æ¥æé ã»ãµã¤ãºé ãªã©ã§ä¸¦ã³æ¿ãã¦ä¸ããã
- å¦çã®å¯¾è±¡ã¨ãªãããã¯ã«ããã¯ä¿è·ã»ã·ã¼ãä¿è·ã»ã»ã«ä¿è·ãªã©ãããã£ã¦ããªããã¨ã確èªãã¦ä¸ããã
- ãã¼ã¿ã®ä¸ç«¯ã¯CurrentRegionã§å¤å®ãã¾ããCurrentRegionã§ã©ã®ãããªç¯å²ãåå¾ããããã¯ã該å½ã®ã»ã«ã§ãShiftãï¼ãCtrlãï¼ã*ããæ¼ãã°ç¢ºèªãããã¨ãã§ãã¾ããï¼è©²å½ã®ã»ã«ã空ç½ã§ããé£æ¥ãã8æ¹åã®ããããã«ãã¼ã¿ãåå¨ãã¦ããã°ããããã空ç½ã§å²ã¾ãããã¼ã¿é¡ãç©å½¢ç¯å²ã§é¸æãã¾ãï¼
Â
ããã¯ãéãã»ã³ãã¼ããã»ãã¼ã¹ãããã»ããã¯ãéããã¨ãã£ãã人éãè¡ãå¦çããã¯ãã§åå§çã«è¡ã£ã¦ããã ããªã®ã§ãæ°ãå¤ããªãã¨ã©ããã¦ãå¦çã«æéããããã¾ãã
ã¨ãã£ã¦ãããã¤ã¬ã«è¡ã£ã¦æ»ã£ã¦ããé ã«ã¯çµãã£ã¦ãã¾ãã・・・・・・ã
ãã£ã¨ããããã£ããããã°ã©ã ã使ãã®ã ãããå
é¨çã«å¦çã§ããªããã®ãªã®ããªï¼ï¼ç»é¢è¡¨ç¤ºã®æ´æ°ãFalseã«ããã¨ããæå³ã§ã¯ãªãï¼