ต้องการวางข้อมูลลงในฐานข้อมูลเดิม โดยอ้างอิงจาก เลขที่ Bay

[dryfodd158]

อยากได้สูตรการวางข้อมูลทับข้อมูลเดิมอ้งอิงจากเลขที่ Bay

[dryfodd158]

ต้องการวางข้อมูลลงในฐานข้อมูลเดิม โดยอ้างอิงจาก เลขที่ Bay
ใน Sheet Tag เวลาพิมพ์ข้อมูลลงไปแล้วเก็บไว้ที่ Sheet BackupData ให้ทำกับเลข Bay เดิม ถ้าไม่มีให้ต่อลงไปเรื่อยๆ

[snasui]

จากไฟล์ที่แนบมา Code ที่เขียนไว้แล้วชื่อว่าอะไร อยู่ที่ Module ไหน ติดปัญหาบรรทัดใด กรุณาแจ้งมาด้วยครับ

[dryfodd158]

อยู่ใน Module 9 ครับ ต้องการ กรอกข้อมูลที่ sheet Tag ถ้ามีเลข Bay เดียวกับ Sheet BackupData ให้ทับของเดิมได้เลยครับ ถ้าไม่มีให้ต่อท้ายไปเรื่อยครับ

[snasui]

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

Code: Select all

Sub CreateOrUpdateData()
    Dim shBk As Worksheet
    Dim rngScrs As Range, rngScr As Range
    Dim f As Long
    Dim rngAll As Range, rng As Range
    Dim rngBay As Range
    
    With Worksheets("BackupData")
        Set rngAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    
    With Worksheets("tag")
        If .Range("a3").Value = "" Then Exit Sub
        Set rngScrs = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
    End With
    
    For Each rngScr In rngScrs
        If Application.CountIfs(rngAll.Offset(0, 4), rngScr.Value) > 0 Then
            For Each rng In rngAll
                If rng.Offset(0, 4).Value = rngScr.Value Then
                    rng.Resize(, 4).Value = rngScr.Resize(, 4).Value
                End If
            Next rng
        Else
            With Worksheets("BackupData")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = _
                    rngScr.Resize(, 4).Value
            End With
        End If
    Next rngScr
    
End Sub

[dryfodd158]

ขอรบอีกครั้งครับ จากสูตรที่ได้มาข้อไม่ซ้ำมันไม่บันทึกต่อครับต้องแก้สูตรแบบไหนครับ

[snasui]

Code นั้นหากไม่ซ้ำจะบันทึกต่อลงไปด้านล่างครับ

ลองแนบไฟล์ที่พบว่าไม่บันทึกต่อลงไปด้านล่างมาด้วยจะได้ช่วยดูให้ได้ครับ