ดึงข้อมูลตามที่เลือกใน list

[March201711]

ถ้าจะดึงข้อมูลที่ sheet data ที่ column C โดยดูที่list drop down ที่ขึ้ต้องด้วย เลขใน list ด้วย vba ต้องปรับ code อย่างไรคะ เพราะ data มาแต่ละวันเพิ่มขึ้นลดลงค่ะ

Ex : เลือก drop down ที่ cell S3 เป็น 4 ก็ให้ code vba ดึงตัวเลขที่ขึ้นต้องด้วยเลข 4 ที่ sheet data มาไว้ที่ sheet นี้ แล้วตรง column c ให้เปลี่ยนเป็นตัวเลข ไม่ให้ใช้ text เพราะต้องเอาข้อมูลไปใช้ต่อ

เลือก drop down ที่ cell S3 เป็น 5 ก็ให้ code vba ดึงตัวเลขที่ขึ้นต้องด้วยเลข 5 ที่ sheet data มาไว้ที่ sheet นี้ แล้วตรง column c ให้เปลี่ยนเป็นตัวเลข ไม่ให้ใช้ text เพราะต้องเอาข้อมูลไปใช้ต่อ

[snasui]

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

Code: Select all

Dim iCount As Long, fstLine As Long
Dim strMatch As String, strCount As String
Dim shData As Worksheet, shResult As Worksheet
Set shData = Worksheets("data")
Set shResult = Worksheets("result")
With shResult
    strMatch = .Range("t3").Value & "*"
    strCount = "*" & .Range("t3").Value
End With
With shData
    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.CountIf(.Range("c:c"), strCount)
    With shResult
       .Range("a3").Resize(.UsedRange.Rows.Count, 14).ClearContents
       .Range("a3").Resize(iCount, 14).Value = _
        shData.Range("a" & fstLine).Resize(iCount, 14).Value
    End With
End With

[puriwutpokin]

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

Code: Select all

Dim iCount As Long, fstLine As Long
Dim strMatch As String, strCount As String
Dim shData As Worksheet, shResult As Worksheet
Set shData = Worksheets("data")
Set shResult = Worksheets("result")
With shResult
    strMatch = .Range("t3").Value & "*"
    strCount = "*" & .Range("t3").Value
End With
With shData
    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.CountIf(.Range("c:c"), strCount)
    With shResult
       .Range("a3").Resize(.UsedRange.Rows.Count, 14).ClearContents
       .Range("a3").Resize(iCount, 14).Value = _
        shData.Range("a" & fstLine).Resize(iCount, 14).Value
    End With
End With

อาจารย์ ครับ ตรง

Code: Select all

strCount = "*" & .Range("t3").Value

ควรเป็นตามโจทย์นี้หรือเปล่าครับ ว่าขึ้นต้นด้วยเลขครับ

Code: Select all

strCount = .Range("t3").Value & "*"

[snasui]

ใช้ StrMatch ทั้งสองที่ได้เลย ไม่ต้องใช้ strCount ตอนนี้ปิดไฟล์ไปแล้วและไม่ได้ Save ขอบคุณที่ช่วยเช็คครับ

Code: Select all

    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.CountIf(.Range("c:c"), strMatch)

[March201711]

ได้แล้วค่ะ แก้ตามที่คุณ puriwutpokin แนะนำค่ะ ขอถามต่อนิดนึงค่ะ ถ้าจะเลือกช่วงตาม cell T3 และ V3bต้องปรับอย่างไรคะ
เช่น ถ้าเลือก 0 ที่ cell T3 และเลือก 2 ที่ cell V3 ก็ให้ดึงข้อมูลที่ตัวเลข 2 เท่านั้น

ถ้าเลือก 1 ที่ cell T3 และเลือก 3 ที่ cell V3 ก็ให้ดึงข้อมูลที่ตัวเลข 1 และ 3ต่อกัน

ถ้าเลือก 5 ที่ cell T3 และเลือก 9 ที่ cell V3 ก็ให้ดึงข้อมูลที่ตัวเลข 5 และ 9 ต่อกัน

[snasui]

การดึงข้อมูลลักษณะนั้นไม่เรียกว่าช่วง แต่เป็นการดึงมา 2 รอบคือตาม T3 และ V3

กรุณาปรับ Code มาเองก่อน ติดแล้วค่อยถามกันต่อครับ

[March201711]

ปรับแล้วติดเป็น debug ที่เลข 0น่ะค่ะ

[snasui]

กรณี Error ให้ทำงานต่อด้วย On Error Resume Next

ที่ Error เนื่องจากไม่มีเลข 0 และหากไม่มีเลขใด ๆ ก็จะ Error ลักษณะเดียวกันครับ

[March201711]

ทำตามที่อาจารย์บอกแล้ว พอเลือก เลข 0ที่ T3 และ เลข2 ที่ v3 แล้ว ทำไม runแล้วได้ เลข 1 คะ

[puriwutpokin]

ลองปรับเป็น

Code: Select all

Sub Number()

On Error Resume Next
Dim iCount As Long, fstLine As Long
Dim strMatch As String, strCount As String
Dim shData As Worksheet, shResult As Worksheet
Set shData = Worksheets("data")
Set shResult = Worksheets("result")
With shResult
    strMatch = .Range("t3").Value & "*"
'    strCount = .Range("t3").Value & "*"
    strCount = "*" & .Range("t3").Value
End With
With shData
    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.CountIf(.Range("c:c"), strMatch)
    With shResult
       .Range("a3").Resize(.UsedRange.Rows.Count, 14).ClearContents
       .Range("a3").Resize(iCount, 14).Value = _
        shData.Range("a" & fstLine).Resize(iCount, 14).Value
    End With
End With


With shResult
    strMatch = .Range("V3").Value & "*"
'    strCount = .Range("t3").Value & "*"
    strCount = "*" & .Range("v3").Value
End With
With shData
    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.CountIf(.Range("c:c"), strMatch)
    With shResult
       '.Range("a3").Resize(.UsedRange.Rows.Count, 14).ClearContents
       .Range("a" & Range("c" & Rows.Count).End(xlUp).Row+1).Resize(iCount, 14).Value = _
        shData.Range("a" & fstLine).Resize(iCount, 14).Value
    End With
End With
End Sub

[March201711]

ได้แล้วค่ะ ขอถามอีกนิดนึงค่ะ ถ้า เลือกที่ T3 เป็นเลข 1 และ v3 เลือกเลข 5 โดยให้ดึงข้อมูล จากเลข 1 ถึง เลข 5 ค่ะ

[puriwutpokin]

ลองปรับเป็น

Code: Select all

Sub Number()
On Error Resume Next
Dim iCount As Long, fstLine As Long
Dim strMatch As String, strCount As String
Dim shData As Worksheet, shResult As Worksheet
Set shData = Worksheets("data")
Set shResult = Worksheets("result")
With shResult
    strMatch = .Range("t3").Value & "*"
    strCount = .Range("v3").Value & "*"
End With
With shData
    fstLine = Application.Match(strMatch, .Range("c:c"), 0)
    iCount = Application.Match(strCount, .Range("c:c"), 0) - 3 + Application.CountIf(.Range("c:c"), strCount)
    With shResult
       .Range("a3").Resize(.UsedRange.Rows.Count, 14).ClearContents
       .Range("a3").Resize(iCount, 14).Value = _
        shData.Range("a" & fstLine).Resize(iCount, 14).Value
    End With
End With
End Sub

[March201711]

ทำไมเลือก เลข 7 ถึง เลข 9 ข้อมูล ST000011 มาด้วยคะ

[snasui]

ถ้า เลือกที่ T3 เป็นเลข 1 และ v3 เลือกเลข 5 โดยให้ดึงข้อมูล จากเลข 1 ถึง เลข 5 ค่ะ

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

จากที่ถามมา ถ้า T3 และ V3 มีลักษณะดังนี้ ต้องการให้แสดงแบบไหน อย่างไรครับ

1. T3 ว่าง V3 มีตัวเลข
2. T3 มีตัวเลข V3 ว่าง
3. T3 มีตัวเลขมากกว่า V3

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

[March201711]

แล้วแต่บางงานที่ทำค่ะ บางงานให้ดึงข้อมูลแค่เลขเดียว บางงานก็ดึงข้อมูลตั้งแต่ 1 และ 7 บางงานให้ดึงข้อมูล 1 ถึง 5 เป็นกลุ่มๆค่ะ อาจารย์
ถ้า data ที่ดึงอยู่คนละ file ต้องปรับ code อย่างไรคะ ปรับแล้ว ข้อมูลหายหมดเลยค่ะ
แต่ส่วนใหญ่ให้ดึงเป็น 1 ถึง 3 และ 4 ถึง 5 และ 7 ถึง9

[snasui]

กรุณาอธิบายในสอดคล้องกับสิ่งที่ผมถามทุกข้อครับ

ไม่ว่าจะดึงข้อมูลลักษณะใดก็ตาม หากให้กรอกข้อมูล 2 ช่องและมีการคีย์ข้อมูลตามที่ผมถามไป เราจะจัดการด้วยโปรแกรมอย่างไร อธิบายเป็นรายข้อตามที่ถามครับ

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

[March201711]

ถ้า T3 และ V3 มีลักษณะดังนี้ ต้องการให้แสดงแบบไหน อย่างไรครับ
T3 ว่าง V3 มีตัวเลข
T3 มีตัวเลข V3 ว่าง
T3 มีตัวเลขมากกว่า V3
3 แบบนั้นมีโอกาสที่ผู้ใช้จะเลือกหรือไม่ ถ้าไม่มี ใช้วิธีใดในการป้องกัน

จากคำถามของอาจารย์
1. ดึงค่า V3 เช่น T3=0,V3=5 ให้ดึงค่าเลข 5
2. ดึงค่า T3 เช่น T3=7,V3=0 ให้ดึงค่าเลข 7
3. ดึงทั้ง 2 เลข เช่น T3=8, V3=2 ให้ดึงเลข8ก่อนแล้วเรียงต่อกันตามด้วยเลข2

ทั้ง3 แบบ ผู้ใช้สามารถเลือกเองได้ ถ้าไม่ได้ใช้ในการเปลี่ยน ที่ T3 เองหรือ เปลี่ยนV3 ค่ะ

[snasui]

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

Code: Select all

Dim rs As Range, cri As Range
Dim rt As Range
Dim rtBook As Workbook
Dim dbBook As Workbook
Set rtBook = ThisWorkbook
Dim i As Integer, j As Integer
Dim c1 As Integer, c2 As Integer
With rtBook.Worksheets("result")
    .Range("c2").CurrentRegion.ClearContents
    Set rt = .Range("a2")
    c1 = .Range("t3").Value
    c2 = .Range("v3").Value
End With
Set dbBook = Workbooks.Open(Filename:="C:\Users\Data.xlsx")
j = 1 'Criteria rows
With dbBook.Worksheets("sheet1")
    Set rs = .Range("a2", .Range("n" & .UsedRange.Rows.Count))
    .Range("q1").Value = "Acc"
    If c1 = 0 And c2 > 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 = 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 > 0 And c2 < c1 Then
        .Range("q2").Value = c1 & "*"
        .Range("q3").Value = c2 & "*"
        j = j + 2
    Else
        For i = 0 To c2 - c1
            .Range("q2").Offset(i, 0).Value = c1 + i & "*"
            j = j + i
        Next i
    End If
    Set cri = .Range("q1").Resize(j)
    rs.AdvancedFilter xlFilterCopy, cri, rt
    cri.ClearContents
End With

[March201711]

ได้แล้วค่ะอาจารย์​ ขอบคุณมากค่ะ​

[March201711]

อาจารย์คะ พอปรับใช้ข้อมูลจริง แล้วไม่มีdata ดึงมาที่ sheet result เลยคะ ต้องปรับแก้อย่างไรคะ