Page 1 of 1

VBA พิมพ์ข้อความ และกดลบขอความไม่ได้

Posted: Wed Apr 22, 2015 9:36 pm
by setsunatop
1.ในช่อง Customer ไม่สามารถพิมพ์ได้
2.ในช่อง Demand กับ Distance ไม่สามารถลบข้อมูลให้ให้ไปทั้งหมดได้ครับ ถ้าลบแล้วมันจะขึ้นดีบัค
ความต้องการ = ผมต้องการให้มันสามารถพิมพ์ได้ด้วยครับแล้วโปรแกรมสามารถหาข้อมูลได้เหมือนเดิม

Code: Select all

'Customer Variables*******
Dim idxCust As Integer
Dim Distance()
Dim CustomerNumber As Integer
Dim cDisttance As Long

'Wage Variables *********
Dim FromDist()
Dim ToDist()
Dim SixWT()
Dim TenWT()
Dim TenWCT()

'Vehicle Types***********
Dim wFrom()
Dim wTo()
Dim vType()
Dim cWage As Long

'History Variables*********
Dim hDate()
Dim hEmp()
Dim hCust()
Dim hDem()
Dim hDist()
Dim hWage()

'Employess (Truck Driver)**
Dim vEmp() 'Employee Code
Dim vEmpName() 'Employee Name
Dim vEmpDist() 'Total Employee Distance
Dim vEmpWage() 'Total Wage of Employee

'Balance Job Variables******
Dim OriginalDistArray()
Dim DistArray()     'Total Distance of Each Employee (Truck Driver) be arranged low to hight.
Dim IndexArray()  'Index of Employee (Truck Driver) Data
Dim DailyEmpArray() 'Status of Employee that have been set by checkboxes

Private Sub cbCustomer_Change()
    idxCust = cbCustomer.ListIndex + 1
   tbDistance.Text = CStr(Distance(idxCust, 1))
   cDisttance = CLng(Distance(idxCust, 1))
End Sub

Private Sub tbDemand_Change()
    Dim CustDemand As Long
    Dim UB As Long
    Dim LB As Long
    Dim cVT As Long
    CustDemand = CLng(tbDemand.Text)
     'Find Vehicle Type
     For i = 1 To UBound(wFrom, 1)
        LB = wFrom(i, 1)
        UB = wTo(i, 1)
        'MsgBox CStr(LB) & " " & CStr(UB)
        If ((LB <= CustDemand) And (UB >= CustDemand)) Then
            If (i = 1) Then
                'MsgBox "6 Wheel Truck"
                lbVehicleType.Caption = "6 Wheel Truck"
                cVT = 0
            End If
             If (i = 2) Then
                'MsgBox "10 Wheel Truck"
                lbVehicleType.Caption = "10 Wheel Truck"
                cVT = 1
            End If
             If (i = 3) Then
                'MsgBox "10 Wheel with Container Truck"
                 lbVehicleType.Caption = "10 Wheel with Container Truck"
                 cVT = 2
            End If
        End If
    Next
    'Find Wage
      For i = 1 To UBound(FromDist, 1)
        LB = FromDist(i, 1)
        UB = ToDist(i, 1)
        If ((LB <= cDisttance) And (UB >= cDisttance)) Then
            If (cVT = 0) Then '6 Wheel Truck
               cWage = SixWT(i, 1)
            End If
            If (cVT = 1) Then '10 Wheel Truck
                cWage = TenWT(i, 1)
            End If
            If (cVT = 2) Then '10 Wheel with Container Truck
                cWage = TenWCT(i, 1)
            End If
            lbWage.Caption = CStr(cWage)
        End If
     Next
    
    
    
End Sub

Private Sub UserForm_Initialize()
   initializeprogram
End Sub


Private Sub initializeprogram()
  tbRecord.Text = tbRecord.Text & "Customer" & "                                                                                       " & "Demand" & "                 " & "Distance" & "                  " & "Wage" & vbNewLine
 'Update Variables You Can Adding in New Record Here***********************
    CustomerNumber = 271 'Look at  the last row of customer and fill it here...
    Worksheets("CUSTOMER").Activate
    'Read Combobox Customer
    Me.cbCustomer.List = Worksheets("CUSTOMER").Range("B2:B" & CustomerNumber).Value
    
    'Read Customer Distance to Array
    ReDim Preserve Distance(1 To CustomerNumber, 1)
    For i = 2 To CustomerNumber
        Distance(i - 1, 1) = CStr(Worksheets("CUSTOMER").Cells(i, 3))
    Next
    
    'Read Wage Table to Arrays***********************
    ReDim Preserve FromDist(1 To 11, 1)
    ReDim Preserve ToDist(1 To 11, 1)
    ReDim Preserve SixWT(1 To 11, 1)
    ReDim Preserve TenWT(1 To 11, 1)
    ReDim Preserve TenWCT(1 To 11, 1)
    
    For i = 4 To 14
        FromDist(i - 3, 1) = CStr(Worksheets("WAGE").Cells(i, 1))
        ToDist(i - 3, 1) = CStr(Worksheets("WAGE").Cells(i, 2))
        SixWT(i - 3, 1) = CStr(Worksheets("WAGE").Cells(i, 3))
        TenWT(i - 3, 1) = CStr(Worksheets("WAGE").Cells(i, 4))
        TenWCT(i - 3, 1) = CStr(Worksheets("WAGE").Cells(i, 5))
    Next
    
    'Read Vehicle Types Table to Arrays*****************
    ReDim Preserve wFrom(1 To 3, 1)
    ReDim Preserve wTo(1 To 3, 1)
    ReDim Preserve vType(1 To 3, 1)
    For i = 4 To 6
        wFrom(i - 3, 1) = CStr(Worksheets("VEHICLE").Cells(i, 1))
        If CStr(Worksheets("VEHICLE").Cells(i, 2)) = "" Then
            wTo(i - 3, 1) = "2147483647" 'Integer 32767   Long 2147483647
        Else
            wTo(i - 3, 1) = CStr(Worksheets("VEHICLE").Cells(i, 2))
        End If
        
        vType(i - 3, 1) = CStr(Worksheets("VEHICLE").Cells(i, 3))
    Next
    
     'Combobox Day: Job Order Section **********************************
        With cbDay
            For i = 1 To 31
                .AddItem CStr(i)
            Next i
        End With
        'Combobox Month
        With cbMonth
            For i = 1 To 12
                .AddItem CStr(i)
            Next i
        End With
        'Combobox Year
        With cbYear
            For i = 2556 To 2600
                .AddItem CStr(i)
            Next i
        End With
        
End Sub


Re: VBA พิมพ์ข้อความ และกดลบขอความไม่ได้

Posted: Wed Apr 22, 2015 10:15 pm
by snasui
setsunatop wrote:1.ในช่อง Customer ไม่สามารถพิมพ์ได้
ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub cbCustomer_Change()
    If cbCustomer.ListIndex <> -1 Then
        idxCust = cbCustomer.ListIndex + 1
        tbDistance.Text = CStr(Distance(idxCust, 1))
        cDisttance = CLng(Distance(idxCust, 1))
    End If
End Sub
setsunatop wrote:2.ในช่อง Demand กับ Distance ไม่สามารถลบข้อมูลให้ให้ไปทั้งหมดได้ครับ ถ้าลบแล้วมันจะขึ้นดีบัค
ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub tbDemand_Change()
    Dim CustDemand As Long
    Dim UB As Long
    Dim LB As Long
    Dim cVT As Long
    If IsNumeric(tbDemand.Text) Then
        CustDemand = CLng(tbDemand.Text)
    End If
    ...Other code...    
 

Re: VBA พิมพ์ข้อความ และกดลบขอความไม่ได้

Posted: Thu Apr 23, 2015 11:03 pm
by setsunatop
ขอบคุณมากครับ

ข้อที่ 1 ใช้งานได้ครับผม

แต่ข้อที่ 2 เวลาผมเปลี่ยนค่าแล้ว ค่าในช่อง wage ไม่เปลี่ยนตามครับ

ตัวอย่างเช่น ถ้าเราเลือกให้ในช่อง Customer เป็นร้านดิเรกค้าข้าว ค่าในช่อง Distance จะเป็น 31.1 โดยอัตโนมัติ และให้ช่อง Demand เป็น 13001 คำตอบ ช่อง Wage จะเป็น 250

สิ่งที่ต้องการคือ ถ้าผมเปลี่ยนค่าใช่อง Distance ให้เป็น 250 ค่าในช่อง Wage จะต้องเปลี่ยนเป็น 300 ตามเกณท์ของระยะทาง ในชีด WAGE

Re: VBA พิมพ์ข้อความ และกดลบขอความไม่ได้

Posted: Fri Apr 24, 2015 4:26 pm
by snasui
:D ลองปรับมาเองก่อน ติดแล้วค่อยถามกันต่อครับ