Page 1 of 1

ช่วยดู code ให้หน่อยครับ

Posted: Mon Jan 28, 2019 4:02 pm
by 4ko6yon61
ต้องการ เทียบค่า จาก 2 ไฟล์ ว่าตรงกันหรือไม่ (Score1.xlsx กับ Score1.xlsx) ใน Range("A1:M20")

ในไฟล์ CheckScore.xlsm
หากทั้งสองไฟล์ไม่มีค่าใน ช่องนั้นๆ ก็ใส่ค่า ""
หากค่าตรงกันก็เอาค่านั้นมาวาง
หากไม่ตรงกันก็ใส่ค่า "NO"

Code: Select all

Sub ScoreCheck()
    Dim CheckScore As Range
    Dim Score1 As String
    Dim Score2 As String

Set wb1 = Workbooks.Open("D:\Score1.xlsx")
Set wb2 = Workbooks.Open("D:\Score2.xlsx")

For Each CheckScore In Workbooks("CheckScore.xlsm").Sheets("sheet1").Range("A1:M20")

        Score1 = wb1.Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value
        Score2 = wb2.Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value
    If Score1 = "" And Score2 = "" Then
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = ""
    ElseIf Score1 = Score2 Then
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = Score1
    Else
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = "No"
    End If
 Next CheckScore
 
wb1.Close False
wb2.Close False
End Sub
ไม่ทราบว่า มีวิธีเขียนโค้ตแบบอื่นที่กระชับกว่านี้มั้ยครับ หรือแนวคิดอื่นๆ และมีวิธีรัน Workbooks.Open ไม่ให้กระพริบ ไหมครับ

Re: ช่วยดู code ให้หน่อยครับ

Posted: Mon Jan 28, 2019 4:48 pm
by puriwutpokin
4ko6yon61 wrote: Mon Jan 28, 2019 4:02 pm ต้องการ เทียบค่า จาก 2 ไฟล์ ว่าตรงกันหรือไม่ (Score1.xlsx กับ Score1.xlsx) ใน Range("A1:M20")

ในไฟล์ CheckScore.xlsm
หากทั้งสองไฟล์ไม่มีค่าใน ช่องนั้นๆ ก็ใส่ค่า ""
หากค่าตรงกันก็เอาค่านั้นมาวาง
หากไม่ตรงกันก็ใส่ค่า "NO"

Code: Select all

Sub ScoreCheck()
    Dim CheckScore As Range
    Dim Score1 As String
    Dim Score2 As String

Set wb1 = Workbooks.Open("D:\Score1.xlsx")
Set wb2 = Workbooks.Open("D:\Score2.xlsx")

For Each CheckScore In Workbooks("CheckScore.xlsm").Sheets("sheet1").Range("A1:M20")

        Score1 = wb1.Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value
        Score2 = wb2.Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value
    If Score1 = "" And Score2 = "" Then
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = ""
    ElseIf Score1 = Score2 Then
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = Score1
    Else
        Workbooks("CheckScore.xlsm").Sheets("sheet1").Cells(CheckScore.Row, CheckScore.Column).Value = "No"
    End If
 Next CheckScore
 
wb1.Close False
wb2.Close False
End Sub
ไม่ทราบว่า มีวิธีเขียนโค้ตแบบอื่นที่กระชับกว่านี้มั้ยครับ หรือแนวคิดอื่นๆ และมีวิธีรัน Workbooks.Open ไม่ให้กระพริบ ไหมครับ
ไม่ให้กระพริบ ใช้เป็น

Code: Select all

'Other code...
Application.ScreenUpdating = False
'Other code...Workbooks.Open
Application.ScreenUpdating = True
'Other code...
ถ้าติดอะไร ควรแนบไฟล์ตัวอย่างมาด้วยครับ

Re: ช่วยดู code ให้หน่อยครับ

Posted: Mon Jan 28, 2019 7:26 pm
by 4ko6yon61
ขอบคุณมากครับ แต่มันก็ยังกระพริบอยู่นิดนึง พอรับได้ครับ