ขอความช่วยเหลือการเขียนโปรแกรมหาข้อมูลครับ

[pichetppp]

สวัสดีครับทุกท่านครับ
รบกวนขอความช่วยเหลือด้วยครับ
คือมีโจทย์ว่า
ผมต้องการเอาเอกสาร มาค้นหาข้อมูล File 1 และ File 2 เป็นไฟล์ที่จะนำตัวเลข 10 หลักในแต่ละเซลล์ไปหาในไฟล์ฐานข้อมูลชื่อ "DATA"
เมื่อหาเจอให้นำข้อมูลที่หามาได้แสดงไว้ในไฟล์ทั้งคู่ หากไม่มีข้อมูลให้เปลี่ยนสีตัวอักษรเป็นสีแดง
โดยทำอีกไฟล์เป็น Text box 2 อัน ไว้กรอกชื่อไฟล์และกำหนดให้เอาไฟล์ไปไว้ใน folder เดียวกันโดยชื่อว่า data เมื่อกรอกข้อมูลแล้วกดปุ่มดำเนินการค้นหา จะดำเนินการดังที่ได้กล่าวมาแล้วครับ
แสดงภาพตัวอย่างในเอกสาร View ครับ

[snasui]

การคลิกปุ่มแล้วให้โปรแกรมทำงานค้นหาข้อมูลตามต้องการนั้น จำเป็นต้องใช้ VBA ครับ ซึ่งจำเป็นต้องเขียนมาก่อนเสมอ ติดตรงไหนสามารถถามกันได้เรื่อย ๆ ครับ

[pichetppp]

สวัสดีอีกครั้งครับ
คือผมไม่ค่อยจะเก่งในการทำ vba นะครับ ขอคำแนะนำการเริ่มต้นได้ไหมครับ
เพราะผมไม่ค่อยมีความชำนาญเท่าที่จะทำได้หมดนะครับ เริ่มต้นก็ยังติดว่า
ทำอย่างไรถึงจะรับค่าจาก text box แล้วดำเนิกการได้นะครับ
แต่มีคนแนะนำมาว่าน่าจะลองดู แต่ก็ยังทำไม่ได้สักที เลยอยากรู้ว่าถ้า อาจารย์
จะพอแนะว่าควรต้องเขียนอย่างไรดี เพราะผมไม่ค่อยมีตัวอย่างและมีเวลาที่จำกัด
เลยศึกษาได้ไม่หมดนะครับ
ผมเลยได้แต่คิดว่า vba น่าจะทำได้ แต่ก็ทำไม่ถูกสักที
ผมก็แค่มีพื้นฐานทำให้แสดงตัวอักษร และใช้ macro เท่านั้นนะครับ

แนะนำด้วยครับ

[snasui]

กรณีไม่เคยเขียนมีทางเลือกคือให้ผู้ที่เข้าใจและเขียนได้เขียนมาก่อนครับ ติดตรงไหนสามารถถามมาได้เรื่อย ๆ เนื่องจากผมเน้นตอบเฉพาะที่เป็นปัญหา และจะบอกกับเพื่อนสมาชิกทุกคนเช่นนี้เท่าเทียมกันครับ การสอนให้เขียน VBA ได้นั้นต้องใช้เวลามากเนื่องจากเป็น Programming คือเป็นภาษาในการเขียนโปรแกรมคอมพิวเตอร์ หากจำเป็นต้องใช้งาน VBA ควรเริ่มศึกษาจากหนังสือและการฝึกบันทึก Macro เพื่อดู Code ที่ได้และนำมาปรับใช้งานครับ

[pichetppp]

ขอบคุณครับ

คงต้องใช้วิธีเดิมๆต่อไปก่อน
ปัญญาน้อยไม่พอ เวลาก็ไม่มี กรรมจริงๆ

ขอบคุณครับ

[snasui]

อย่าเพิ่งท้อถอยครับ การศึกษา VBA อาศัยความอดทนเป็นที่ตั้งเพราะต้องฝึกฝนเยอะ ลำพังการอ่านอย่างเดียวนั้นไม่ได้ช่วยอะไรครับ ผมและเพื่อนสมาชิกทั้งหลายก็ล้วนมีงานประจำเช่นกัน ที่ผมตอบได้เร็วอาศัยประสบการณ์เป็นหลักเนื่องจากคลุกคลีกับ Excel มานานครับ (อ่านเพิ่มเติม...)

[pichetppp]

ขอบคุณครับ

ถ้าสงสัย ทำไม่ได้ จะมาถามเพิ่มนะครับ

ตอนนี้ขอหาวิธีแก้โดยความสามารถเท่าห่างอึงก่อนนะครับ

ขอบคุณครับ

[pichetppp]

สวัสดีครับ
ช่วยแนะนำการเขียน Code เมื่อเราหาค่าในเซลล์ที่มีตัวเลข 10 ตัว แล้วเจอรายการที่ซ้ำกัน
ให้ลบทิ้งในแถวที่ซ้ำกันทั้งแถว และหาต่อจนกว่าจะไม่ซ้ำกันหมดนะครับ
ผมลองทำดู
Dim c, d
c = 1
d = 2
For singleC= 1 To ActiveSheet.Cells.Count
If Cells(c, 1) = Cells(d, 1) Then
Rows("d").Select
Selection.Delete Shift:=xlUp
c = c + 1
d = d + 1
End If
Next singleC
มันไม่ได้นะครับ งงอยู่นานแล้วครับ

[snasui]

แนบไฟล์ตัวอย่างมาด้วยจะได้สะดวกในการทดสอบครับ

[pichetppp]

สวัสดีครับ
เอกสารตัวอย่างที่ทำอยู่ครับ

[snasui]

ลองเปลี่ยนจาก

Code: Select all

Dim c, d
c = 1
d = 2
For singleC= 1 To ActiveSheet.Cells.Count
If Cells(c, 1) = Cells(d, 1) Then
Rows("d").Select
Selection.Delete Shift:=xlUp
c = c + 1
d = d + 1
End If
Next singleC

เป็นด้านล่างครับ

Code: Select all

i = 1
Do While Cells(i, "C") <> ""
    If Cells(i, "C") = Cells(i + 1, "C") Then
        Cells(i, "C").EntireRow.Delete
    Else
        i = i + 1
    End If
Loop

[pichetppp]

สวัสดีครับ
ทดลองแล้วครับ
ไม่เปลี่ยนแปลงครับ
แถวที่ซ้ำกันไม่ถูกลบออกไปครับ
ไม่แน่ใจว่าต้องแก้อะไรเพิ่มหรือเปล่าครับ

[tupthai]

ลองแบบนี้บ้างครับผม
Public Sub find()
Dim R, singleCell, ws, rangeToUse, LastRow
Worksheets(1).Cells.ClearContents
Worksheets(1).Columns(1).NumberFormat = "@"
R = 1
For ws = 2 To Worksheets.Count
For Each singleCell In Worksheets(ws).UsedRange
If singleCell.Value Like "##########" Then
R = R + 1
Worksheets(1).Cells(R, 1).Value = singleCell.Value
Worksheets(1).Cells(R, 2).Value = singleCell.Offset(0, 1).Value
Worksheets(1).Cells(R, 3).Value = singleCell.Offset(0, 2).Value
End If
Next singleCell
Next ws

LastRow = Range("A" & Rows.Count).End(xlUp).Row
With Range("E2:E" & LastRow)
.FormulaR1C1 = "=IF(COUNTIF(R1C1:RC[-4],RC[-4])>1,NA())"
.SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
.ClearContents
End With
End Sub

[pichetppp]

ขอบคุณครับ คุณ tupthai
แต่ผมลองใช้ในข้อมูลขนาดใหญ่ที่ต้องทำงานจริง
แล้ว ค้างที่หน้าจอขาวไปต่อไม่ได้ครับ
คงต้องลองหาวิธีแก้ไข

ขอบคุณนะครับ ได้ไอเดียเพิ่มอีกวิธี

[tupthai]

ขอบคุณครับ คุณ tupthai
แต่ผมลองใช้ในข้อมูลขนาดใหญ่ที่ต้องทำงานจริง
แล้ว ค้างที่หน้าจอขาวไปต่อไม่ได้ครับ
คงต้องลองหาวิธีแก้ไข

ขอบคุณนะครับ ได้ไอเดียเพิ่มอีกวิธี

ขอสอบถามเพิ่มเติมนิดนึงครับ ที่ว่าข้อมูลขนาดใหญ่ มีประมาณกี่ชีท และกี่แถวครับ
จะได้ประเมินถูกครับผม

[pichetppp]

ข้อมูลเพิ่มเติมครับ
โดยที่ใช้กับข้อมูล 1,000 แถวเป็นอย่างต่ำ
แต่ไม่น่าถึง 10,000 ในตอนนี้ แต่อนาคตบอกไม่ได้ข้อมูลเพิ่มตลอดครับ
ส่วนที่เกิดปัญหาที่พบจากการลองรันดูที่ละขั้นตอนพบว่าจะค้างที่ขั้นตอนการลบ
โดยขึ้นข้อความ FALSE ที่ column E แล้วจะค้างไปเลย

[snasui]

กรณีที่ข้อมูลเรียงตามคอลัมน์ C แล้ว Code ด้านล่างนี้ทำงานถูกต้องแน่นอนครับ

Code: Select all

i = 1
Do While Cells(i, "C") <> ""
    If Cells(i, "C") = Cells(i + 1, "C") Then
        Cells(i, "C").EntireRow.Delete
    Else
        i = i + 1
    End If
Loop

แต่หากข้อมูลไม่ได้จัดเรียง ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

    i = 1
    For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
        If Application.CountIf(Range("C1:C" & i), Cells(i, "C")) > 1 Then
            Cells(i, "C").Clear
        End If
    Next i
    If Application.CountIf(Range("C:C"), "") > 0 Then
        Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If

[pichetppp]

สวัสดีครับ อาจารย์
ผมลองแก้ไขนิดหน่อย คือว่าผมต้องการ column A แทน C
และผลที่ได้ใช่เลยครับ
ทั้งข้อมูลที่จะใช้จริงด้วยครับ
สุดยอดเลย
ผ่านไปอีกขั้นแล้วครับ
ยังมีอีกหลาย step
ขอบคุณครับ

แล้วจะเข้ามาถามอีกครับ
(ในห้วข้อนี้ครับ)

[pichetppp]

สวัสดีครับ
ขอถามเพิ่มเติมครับ
ผมลองหาวิธีเอาตัวเลข 10 หลักที่อยู่ใน sheet 1 เอกสารแรก
มาทำการหาต่อว่ามีอยู่ใน เอกสารที่สองหรือไม่
ถ้ามีให้นำรายการใน column B ในเอกสารที่สอง
มาเพิ่มใน column D ของเอกสารแรก
และถ้าไม่มีให้แสดงค่าว่า NO DATA ใน column D ของเอกสารแรก และเปลี่ยนสีเป็นสีแดง
ผมลองใช้แมโครแล้ว และลองแก้ไข code แล้วไม่สามารถทำได้นะครับ อยู่ใน Module 2

Code: Select all

Dim i As Integer
    i = 1
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Selection.Copy.Range("A" & i).Value
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\T02083\My Documents\ref.xls"
    Windows("ref.xls").Activate
     If Workbooks("test yes0 t1.xls").Range("A" & i).Value = Range("A" & i).Value Then
     Selection.Copy.Range("B" & i).Value
     Windows("test yes0 t1.xls").Activate
     Range("D" & i).Select
    ActiveSheet.Paste
    Else
    ActiveCell.FormulaRiCi = "no data"
    Rows("i:i").Select
    Selection.Font.ColorIndex = 3
    End If
    Next i
End Sub

ช่วยแนะนำด้วยครับ

[tupthai]

Code: Select all

Dim wb1, wb2 As Workbook

Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
LastRow1 = wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Set wb2 = Workbooks.Open("C:\Documents and Settings\My Documents\ref.xls", False, False)
LastRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To LastRow1
    For j = 1 To LastRow2
        If wb2.Sheets(1).Range("A" & j).Value = wb1.Sheets(1).Range("A" & i).Value Then
           wb1.Sheets(1).Range("D" & i).Value = wb2.Sheets(1).Range("B" & j).Value
           f = 1
        End If
    Next j
   If f = 0 Then
        wb1.Sheets(1).Range("D" & i).Value = "no data"
        wb1.Sheets(1).Range("D" & i).Font.ColorIndex = 3  
   End If
   f = 0
Next i

wb2.Close False
Application.ScreenUpdating = True