:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่นแล้ว

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#21

Post by snasui »

:D ลองดุตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Private Sub CmdConvrt_Click()
    Dim Handle As Integer, File_Name As String
    Dim WriteRow As Long, TemArr, OneLine As String
    Dim Price1, Price2, Price3 As String
    Dim Pono() As Variant
    Dim Invno() As String
    Dim Chkval As Integer
    Dim Sump1 As Integer
    Dim Sump2 As Integer
    Dim Sump3 As Integer
    Dim Sumpr As Integer
    Dim Sumprice As Integer
    Handle = FreeFile
    File_Name = "D:\testrun.txt"
    Open File_Name For Input As #Handle
    Do While Not EOF(Handle)
        Line Input #Handle, OneLine
        TemArr = Split(OneLine, "|")
        If UBound(TemArr) > 1 Then
            WriteRow = WriteRow + 1
            Cells(WriteRow, 1) = "VMI050"
            Cells(WriteRow, 2) = TemArr(1)
            Cells(WriteRow, 3) = TemArr(2)
            'Pono = TemArr(4)
            Cells(WriteRow, 4) = TemArr(4)
            Cells(WriteRow, 5) = TemArr(5)
            Cells(WriteRow, 6) = TemArr(5)
            Cells(WriteRow, 7) = TemArr(7)
            Cells(WriteRow, 8) = TemArr(8)
            Cells(WriteRow, 9) = "   PC"
            If TemArr(4) = 9999999999# Then
                Cells(WriteRow, 9) = "     "
                Cells(WriteRow, 11).Value = Application.Sum( _
                    Range("K1:K" & WriteRow))
            End If
            If TemArr(29) = "S225-1-1011-001" Then
                Cells(WriteRow, 10) = Txtprc1.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc1
                Sump1 = Cells(WriteRow, 11)
            ElseIf TemArr(29) = "S225-1-1211-002" Then
                Cells(WriteRow, 10) = Txtprc2.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc2
                Sump2 = Cells(WriteRow, 11)
            ElseIf TemArr(29) = "S225-1-DUMM-001" Then
                Cells(WriteRow, 10) = Txtprc3.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc3
                Sump3 = Cells(WriteRow, 11)
            End If
            'Cells(WriteRow, 11) = TemArr(8) * DC
            Cells(WriteRow, 12) = TemArr(9)
            Cells(WriteRow, 13) = TemArr(24)
            Cells(WriteRow, 14) = TemArr(25)
            Cells(WriteRow, 15) = TemArr(26)
            Sumpr = Sump1 + Sump2 + Sump3
            'Sumprice = Sumpr + Sumprice
            'Sumprice = Sumprice + Sumpr
        End If
        'Sumprice = Sumprice + Sumpr
    Loop
    Close #Handle
End Sub
Top
whatman
Member
Member
Posts: 17
Joined: Fri Feb 15, 2013 11:12 am

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#22

Post by whatman »

ขอบคุณครับ
ทีนี้ผมดึงข้อมูลในคอลัมน์ D ที่ใส่ไว้ใน excel ขึ้นมาใส่ไว้ใน listbox1 แล้วผมต้องการที่จะเลือกข้อมูลที่อยู่ใน listbox1 ออกมาจำนวนหนึ่งแบบ move มาใส่ไว้ใน textbox2 แล้วพิมพ์ค่าที่จะแทนที่นั้นลงไปในคอลัมน์ D อย่างเช่นเลือก 21M0008243 21M0008255 21M0008262 21M0008266 4จำนวนนี้ออกมาแล้วแทน 4 ตัวนี้ให้เป็น INV1302001 ลงไปในคอลัมน์ D โดยพิมพ์ ค่า INV1302001 ใน combobox1

Code: Select all

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As String
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Application.Range("A1:z999") = ""
ListBox1.Value = Null
Do While Not EOF(Handle)
    Line Input #Handle, OneLine
    TemArr = Split(OneLine, "|")
    If UBound(TemArr) > 1 Then
        WriteRow = WriteRow + 1
        Cells(WriteRow, 1) = "VMI050"
        Cells(WriteRow, 2) = TemArr(1)
        Cells(WriteRow, 3) = TemArr(2)
        Cells(WriteRow, 4) = TemArr(4)
        ListBox1.AddItem (TemArr(4))
        ComboBox1.AddItem (TemArr(4))
        Cells(WriteRow, 5) = TemArr(5)
        Cells(WriteRow, 6) = TemArr(5)
        Cells(WriteRow, 7) = TemArr(7)
        Cells(WriteRow, 8) = TemArr(8)
        Cells(WriteRow, 9) = "   PC"
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 9) = "     "
        Cells(WriteRow, 11).Value = Application.Sum(Range("K1:K" & WriteRow))
        End If
        If TemArr(29) = "S225-1-1011-001" Then
        Cells(WriteRow, 10) = Txtprc1.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc1
        ElseIf TemArr(29) = "S225-1-1211-002" Then
        Cells(WriteRow, 10) = Txtprc2.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc2
        ElseIf TemArr(29) = "S225-1-DUMM-001" Then
        Cells(WriteRow, 10) = Txtprc3.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc3
        End If
        Cells(WriteRow, 12) = TemArr(9)
        Cells(WriteRow, 13) = TemArr(24)
        Cells(WriteRow, 14) = TemArr(25)
        Cells(WriteRow, 15) = TemArr(26)
    End If
Loop
Close #Handle
End Sub

Private Sub CmdSavefiles_Click()
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\testfile.txt", FileFormat:=xlTextMSDOS, _
        CreateBackup:=False
End Sub

Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)

End Sub



Private Sub ListBox1_Click()

End Sub

Private Sub ScrollBar1_Change()

End Sub

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc2_Change()
    If Me.Txtprc2.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc2
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc3_Change()
    If Me.Txtprc3.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc3
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub
Attachments
testrun.xlsm
(37.05 KiB) Downloaded 16 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#23

Post by snasui »

:D ได้เขียน Code สำหรับการทำเช่นนั้นแล้วยังครับ Code ชื่อว่าอะไร ติดขัดตรงบรรทัดไหนครับ
Top
whatman
Member
Member
Posts: 17
Joined: Fri Feb 15, 2013 11:12 am

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#24

Post by whatman »

ตรง listbox ตัวซ้ายผมจะดึงข้อมูลจากคอลัมน์ D เข้ามาทั้งหมดแล้วเมื่อกดเลือก add ข้อมูลจะเข้ามา listbox ตัวขวาครับ
ทีนี้ผมต้องการให้ข้อมูลที่เลือกไว้ใน listbox ด้านขวาสมมติว่าเลือก 21M0008244 , 21M0008259 , 21M0008263
ทีนี้ผมต้องการแทนที่ข้อมูล 21M0008244 , 21M0008259 , 21M0008263 ลงไปในตำแหน่งที่ข้อมูลตัวนี้อยู่ด้วยตัว A
และเลือกข้อมูล add ชุดใหม่เข้ามา และใส่เป็น B ไปเรื่อยๆจนครบครับ
แล้วใน txtbox ด้านล่างผมใส่ A ลงไปและกดปุ่มเพื่อให้ข้อมูลโยนกลับเข้าไปแทนแต่ทำไม่ได้ครับ

Code: Select all

Private Sub CmdAddInv_Click()
If Application.Range("D1:D") = LstPoc.Value Then
Cells(WriteRow, 4) = TxtInv.Value
End If
End Sub

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As Integer
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Price1 = 1
Price2 = 2
Price3 = 3
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Application.Range("A1:z999") = ""
LstPoa.Value = Null
Do While Not EOF(Handle)
    Line Input #Handle, OneLine
    TemArr = Split(OneLine, "|")
    If UBound(TemArr) > 1 Then
        WriteRow = WriteRow + 1
        Cells(WriteRow, 1) = "VMI050"
        Cells(WriteRow, 2) = TemArr(1)
        Cells(WriteRow, 3) = TemArr(2)
        Cells(WriteRow, 4) = TemArr(4)
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 4) = 999999999999999#
        End If
        If TemArr(4) = 9999999999# Then
        TemArr(4) = ""
        Else
        LstPoa.AddItem (TemArr(4))
        End If
        Cells(WriteRow, 5) = TemArr(5)
        Cells(WriteRow, 6) = TemArr(5)
        Cells(WriteRow, 7) = TemArr(7)
        Cells(WriteRow, 8) = TemArr(8)
        Cells(WriteRow, 9) = "   PC"
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 9) = "     "
        Cells(WriteRow, 11).Value = Application.Sum(Range("K1:K" & WriteRow))
        End If
        If TemArr(29) = "S225-1-1011-001" Then
        'Cells(WriteRow, 10) = Txtprc1.Value
        'Cells(WriteRow, 11) = TemArr(8) * Txtprc1
        Cells(WriteRow, 10) = Price1
        Cells(WriteRow, 11) = TemArr(8) * Price1
        ElseIf TemArr(29) = "S225-1-1211-002" Then
        Cells(WriteRow, 10) = Price2
        Cells(WriteRow, 11) = TemArr(8) * Price2
        ElseIf TemArr(29) = "S225-1-DUMM-001" Then
        Cells(WriteRow, 10) = Price3
        Cells(WriteRow, 11) = TemArr(8) * Price3
        End If
        Cells(WriteRow, 12) = TemArr(9)
        Cells(WriteRow, 13) = TemArr(24)
        Cells(WriteRow, 14) = TemArr(25)
        Cells(WriteRow, 15) = TemArr(26)
    End If
Loop
Close #Handle
End Sub

Private Sub CmdMove_Click()
LstPoc.AddItem (LstPoa.Value)
End Sub

Private Sub CmdSavefiles_Click()
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\testfile.txt", FileFormat:=xlTextMSDOS, _
        CreateBackup:=False
End Sub

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc2_Change()
    If Me.Txtprc2.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc2
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc3_Change()
    If Me.Txtprc3.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc3
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

End Sub

Private Sub LstPoa_Click()

End Sub
Attachments
testfile.rar
(40.14 KiB) Downloaded 17 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#25

Post by snasui »

:D ลองปรับ Private Sub CmdAddInv_Click เป็นตามด้านล่างครับ

Code: Select all

Private Sub CmdAddInv_Click()
    Dim i As Integer, j As Integer
    Dim rAll As Range, r As Range
    With Sheets("bis225")
        Set rAll = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
    End With
    i = LstPoc.ListCount
    For Each r In rAll
        For j = 0 To i - 1
            If r = LstPoc.List(j) Then
                r = TxtInv.Value
            End If
        Next j
    Next r
End Sub
Top
whatman
Member
Member
Posts: 17
Joined: Fri Feb 15, 2013 11:12 am

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#26

Post by whatman »

ช่วยดู Private Sub CmdInsertRow ด้วยครับ
ต้องการที่จะแทรกบรรทัดที่ข้อมูลไม่ซ้ำกันออก โดยข้อมูลจะเรียงกัน ตรง คอลัมน์ D เช่น
01
01
01
01
แทรกข้อมูลเข้ามาครับ
02
02
02
แทรกข้อมูลเข้ามา
03
03
03
03
ตรงนี้ผมไม่รู้จะวนอย่างไรให้เจอบันทัดที่ข้อมูลในคอลัมน์ D ที่บรรทัดบนกันล่างไม่เหมือนกัน

เมื่อเจอแล้วผมจะลองแทรกและใส่ข้อมูลบางอย่างในแถวที่แทรกนี้ครับ
Attachments
testrun.rar
(37.86 KiB) Downloaded 10 times
Top
User avatar
tupthai
Bronze
Bronze
Posts: 302
Joined: Sat Feb 04, 2012 2:49 pm

Re: ทำ vba ไว้ที่เครื่องตัวเองเปิดได้แต่ไปเปิดกับเครื่องอื่น

#27

Post by tupthai »

ตรวจสอบ บรรทัดบนกับล่าง :D

Code: Select all

Private Sub CmdInsertRow_Click()
    Dim i As Integer, j As Integer
    Dim rAll As Range, r As Range
    With Sheets("bis225")
        Set rAll = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
           If r.Value = r.Offset(1, 0).Value Then
                  'your code
           Else
                  'your code
                  'r.EntireRow.Insert
           End If
    Next r
End Sub
Top
Post Reply

Return to “Excel Macro & VBA”