Excel Forum

Code: Select all

Sub im_money()
    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Set MstWbk = ThisWorkbook
    FNames = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="เลือกไฟล์ที่จะนำเข้าตรวจสอบ")
    If Not IsArray(FNames) Then Exit Sub
    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count) ' คัดลอกแผ่นงานไปท้ายสุด
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(1, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt
    ' ลบแผ่นงานชั่วคราวหลังจากนำเข้าเสร็จสิ้น (ถ้าไม่ต้องการ)
    Application.DisplayAlerts = False
    MstWbk.Sheets(MstWbk.Sheets.Count).Delete
    Application.DisplayAlerts = True
    Call addname 'นำเข้าชื่อ workbook มาใส่ในช่อง B6:B29
    Application.ScreenUpdating = True
    MsgBox "นำเข้าไฟล์สำเร็จ!", vbInformation
    Worksheets(1).Activate
End Sub

Code: Select all

Sub addname()

Application.DisplayAlerts = False

   If ActiveWorkbook.Worksheets.Count >= 1 Then
      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
    End If
   
   Application.DisplayAlerts = True
   
End Sub

Code: Select all

Sub addname2()

Application.DisplayAlerts = False

   If ActiveWorkbook.Worksheets(2).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
   End If
   
   If ActiveWorkbook.Worksheets(3).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
   End If

   If ActiveWorkbook.Worksheets(4).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
   End If
   
   If ActiveWorkbook.Worksheets(5).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
   End If
   
   If ActiveWorkbook.Worksheets(6).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
   End If
   
   If ActiveWorkbook.Worksheets(7).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
   End If
   
   If ActiveWorkbook.Worksheets(8).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
   End If
   
   If ActiveWorkbook.Worksheets(9).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
    End If
      
   If ActiveWorkbook.Worksheets(10).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
   End If
   
   
   If ActiveWorkbook.Worksheets(11).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
   End If
   
   If ActiveWorkbook.Worksheets(12).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
   End If
   
   If ActiveWorkbook.Worksheets(13).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
   End If
   
   If ActiveWorkbook.Worksheets(14).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
   End If
   
   If ActiveWorkbook.Worksheets(15).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
   End If
   
   If ActiveWorkbook.Worksheets(16).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
   End If
   
   If ActiveWorkbook.Worksheets(17).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
   End If
   
   If ActiveWorkbook.Worksheets(18).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
   End If
   
   If ActiveWorkbook.Worksheets(19).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
   End If
   
   If ActiveWorkbook.Worksheets(20).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
   End If
   
   If ActiveWorkbook.Worksheets(21).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
   End If
   
   If ActiveWorkbook.Worksheets(22).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
   End If
   
   If ActiveWorkbook.Worksheets(23).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
   End If
   
   If ActiveWorkbook.Worksheets(24).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
   End If
   
   If ActiveWorkbook.Worksheets(25).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
   End If
   
   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Sub

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                .Range("b30").End(xlUp).Offset(1, 0).Value = sh.Name
            End With
        End If
    Next sh
'   If ActiveWorkbook.Worksheets.Count >= 1 Then
'      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
'      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
'      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
'      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
'      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
'      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
'      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
'      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
'      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
'      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
'      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
'      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
'      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
'      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
'      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
'      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
'      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
'      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
'      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
'      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
'      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
'      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
'      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
'      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
'    End If
   
   Application.DisplayAlerts = True
   
End Sub

Code: Select all

Public Sub Sum_Money()
    
    Dim myRange As Long
    
    myRange = Worksheets("Sheet2").Range("AQ10").End(xlDown)
    
    Worksheets("Main").Range("C6") = WorksheetFunction.Sum(myRange)

End Sub

Code: Select all

Sub addname()

    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a1000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                End With
                
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 2).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
                End With
            End With
        End If
    Next sh

   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Su

Code: Select all

Sub im_money()
    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet
    
    Dim x As Long
    Dim xx As Integer

    Application.ScreenUpdating = False
    Set MstWbk = ThisWorkbook

    'Call delsheets

    FNames = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="เลือกไฟล์ที่จะนำเข้าตรวจสอบ")
    If Not IsArray(FNames) Then Exit Sub

    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count) ' คัดลอกแผ่นงานไปท้ายสุด
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(1, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt

    ' ลบแผ่นงานชั่วคราวหลังจากนำเข้าเสร็จสิ้น (ถ้าไม่ต้องการ)
    Application.DisplayAlerts = False
    'MstWbk.Sheets(MstWbk.Sheets.Count).Delete
    Application.DisplayAlerts = True
    
For x = 1 To 100
        UpdateProgressBar x, 100
    Next x
    
    Call addname

    Application.ScreenUpdating = True
    
    MsgBox "นำเข้าไฟล์สำเร็จ!", vbInformation

    Worksheets("Main").Activate
End Sub

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a10000"), 0)
                End With
                
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 10000))
                    
                    .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 10000))  
                End With
            End With
        End If
    Next sh
   Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

Code: Select all

Sub hlrow()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    
    'Application.DisplayAlerts = False
    
    For Each sh In Worksheets
        If sh.Index > 1 Then  'มากกว่า 1 ชีท
            With Sheets("Main")
                With sh
                
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                    
                    If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow
          
                End With    
            End With
        End If 
    Next sh
   'Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

Code: Select all

Sub hlrow()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    
    'Application.DisplayAlerts = False
    
    For Each sh In Worksheets
        If sh.Index > 1 Then  'มากกว่า 1 ชีท
            With Sheets("Main")
                With sh
                
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                    
                    If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow
          
                End With    
            End With
        End If 
    Next sh
   'Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a1000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                End With
                
            If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
                    .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
                End With
            End If
            End With
        End If
    Next sh

   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Sub