ขออนุญาตสอบถามปัญหาการนำเข้า workbook อื่น มาได้ไม่ครบและเปลี่ยนชื่อ worksheets ด้วยชื่อ workbook ที่นำเข้าครับ

[9KiTTi]

ที่ปรับมานั้น Code เดิมที่สำคัญหายไปหลายบรรทัดเลยทำงานไม่ได้

Code ที่ทำงานได้จะต้องเป็นตามด้านล่างครับ

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

ปรับแก้ไขได้ตามที่อาจารย์แนะนำแล้วครับ แต่ผมลองเขียน code เพื่อใส่สีเฉพาะแถวใน sheets ที่นำเข้ามา โดย cell ใน คอลัมม์ AQ ที่มีค่าเท่ากับ 0 หรือน้อยกว่า 0 ทั้ง 2 ช่วงข้อมูลคือ InTime กับ OutTime แต่ด้วยความรู้ยังน้อยเกี่ยวกับ VBA จึงทำงานไม่ได้ ขอความอนุเคราะห์ชี้แนะด้วยครับ ขอบพระคุณครับ

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:a10000"), 0)
                    
                    If (sh.Range("aq" & itme & ":aq" & otme)) <= 0 Then .Interior.Color = vbCyan
                    
                End With
                
            End With
        End If
        
    Next sh

   'Application.DisplayAlerts = True
   
   Worksheets("Main").Activate

End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
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:a10000"), 0)
                
'                    If (sh.Range("aq" & itme & ":aq" & otme)) <= 0 Then .Interior.Color = vbCyan
                For Each r In .Range("aq" & itme & ":aq1000")
                    If r.Value <> "" And r.Value <= 0 Then
                        r.Interior.Color = vbCyan
                    End If
                Next r
            End With
            
        End With
    End If
Next sh
'Other code

[9KiTTi]

ที่ปรับมานั้น Code เดิมที่สำคัญหายไปหลายบรรทัดเลยทำงานไม่ได้

Code ที่ทำงานได้จะต้องเป็นตามด้านล่างครับ

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

ที่ปรับมานั้น Code เดิมที่สำคัญหายไปหลายบรรทัดเลยทำงานไม่ได้

Code ที่ทำงานได้จะต้องเป็นตามด้านล่างครับ

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

ขอบพระคุณครับอาจารย์ สามารถแก้ปัญหาได้แล้วครับ แต่ขออนุญาตสอบถามกรณีต้องการปรับให้แสดงสีทั้งแถวตามเงื่อนไขที่กำหนด เพราะเบื้องต้นจะแสดงสีเฉพาะ cell ที่มีค่าตรงกับที่กำหนดครับ แต่ปัญหาคืิอแถวที่แสดงสีจะเกินจำนวนคอลัมม์ของข้อมูลครับ โดยจะแสดงเฉพาะ A : AQ รบกวนอาจารย์แนะนำด้วยครับ

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)

                For Each r In .Range("aq" & itme & ":aq10000")
                    If r.Value <> "" And r.Value <= 0 Then 'เงื่อนไข ไม่เป็นค่าว่าง และ มีค่าน้อยกว่า 0 หรือเท่ากับ 0

                        r.EntireRow.Interior.Color = vbCyan 'ใส่สีฟ้าเฉพาะแถวที่ตรงกับเงื่อนไข
                        
                    End If
                Next r
            End With
            
        End With
    End If
Next sh

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

End Sub

[snasui]

ศึกษา Property ที่ชื่อว่า Offset, Resize แล้วปรับมาเองดูก่อนครับ

https://learn.microsoft.com/en-us/offic ... nge.Offset
https://learn.microsoft.com/en-us/offic ... nge.Resize

[9KiTTi]

ขอบพระคุณครับอาจารย์