ambil nomor trx & nilai gross dan lainnya

  1. 5 bulan yang lalu

    Selamat siang
    saya mohon bantuan untuk mengambil data dari 1 transaksi mengunakan vba,
    sebagian sudah ada tetapi ada nmor trx , tanggal, nilai gross dan disc yang belum bisa di ambil.
    kebetulan file ini saya minta bantu di sini juga..
    terima kasih banyak sebelumnya

  2. Caton

    Jul 18 Terverifikasi Indonesia + 17.741 Poin

    Mas @Agus789 ...

    Untuk nomor trx dan tanggal trx, dalam blok IF berikut :

    If InStr(sel, "PENJUALAN") Then
       No = No + 1
       y = 0
    End If

    ubah menjadi :

    If InStr(sel, "PENJUALAN") Then
        No = No + 1
        y = 0
        
        vArr = Split(Replace(sel, "  ", "|"), "|")
        sTrx = vArr(UBound(vArr) - 1)
        dDate = CDate(vArr(UBound(vArr)))    
    End If

    Selanjutnya, untuk nilai gross dan disc, dalam blok IF :

    If IsNumeric(Left(sel, 8)) And Len(Trim(Left(sel, 8))) = 8 Then

    tambahkan script berikut:

    vdata = Split(Replace(sel.Offset(1).Value2, "  ", "|"), "|")
    dGross = CDbl(Replace(vdata(UBound(vdata)), ",", ""))
    
    vdata = Split(Replace(sel.Offset(2).Value2, "  ", "|"), "|")
    dDisc = CDbl(Replace(vdata(UBound(vdata)), ",", ""))

    Script terakhir ini bisa diletakkan setelah perintah IF atau bisa setelah baris :

    ...
    Qty = Left(sel.Offset(1), InStr(1, sel.Offset(1), "@") - 1) * 1
    
    vdata = Split(Replace(sel.Offset(1).Value2, "  ", "|"), "|")
    dGross = CDbl(Replace(vdata(UBound(vdata)), ",", ""))
    
    vdata = Split(Replace(sel.Offset(2).Value2, "  ", "|"), "|")
    dDisc = CDbl(Replace(vdata(UBound(vdata)), ",", ""))
    
    lRow = Range("C" & Rows.Count).End(xlUp).Row + 1
    With ShTes
    ...

    Kalau perlu, deklarasikan variabel yang digunakan dalam script di atas:

    Dim sTrx As String
    Dim vArr As Variant
    Dim dDate As Double
    Dim dGross As Double
    Dim dDisc As Double

    Demikian, semoga sesuai.

  3. baik mas @Caton saya coba terapkan, terima kasih banyak ya

  4. Caton

    Jul 18 Terverifikasi Indonesia + 17.741 Poin

    Sama-sama mas @Agus789 ... Silahkan dicoba dulu. Diskusikan saja kembali kalau hasilnya tidak tepat atau muncul error.

    Demikian.

  5. seperti ini ya mas @Caton
    End With
    If InStr(sel, "PENJUALAN") Then
    No = No + 1
    y = 0

    vArr = Split(Replace(sel, " ", "|"), "|")
    sTrx = vArr(UBound(vArr) - 1)
    dDate = CDate(vArr(UBound(vArr)))
    End If

    If IsNumeric(Left(sel, 8)) And Len(Trim(Left(sel, 8))) = 8 Then
    vdata = Split(Replace(sel.Offset(1).Value2, " ", "|"), "|")
    dGross = CDbl(Replace(vdata(UBound(vdata)), ",", ""))

    vdata = Split(Replace(sel.Offset(2).Value2, " ", "|"), "|")
    dDisc = CDbl(Replace(vdata(UBound(vdata)), ",", ""))

    y = y + 1
    xItem = No + y / 100
    SKU = Left(sel, 8)
    Val = UBound(Split(sel, " "))
    Val = WorksheetFunction.Substitute(sel, " ", "|", Val)
    Val = Mid(sel, InStr(Val, "|"), 50)
    Qty = Left(sel.Offset(1), InStr(1, sel.Offset(1), "@") - 1) * 1
    vdata = Split(Replace(sel.Offset(1).Value2, " ", "|"), "|")
    dGross = CDbl(Replace(vdata(UBound(vdata)), ",", ""))

    vdata = Split(Replace(sel.Offset(2).Value2, " ", "|"), "|")
    dDisc = CDbl(Replace(vdata(UBound(vdata)), ",", ""))


    lRow = Range("C" & Rows.Count).End(xlUp).Row + 1
    With ShTes
    .Cells(lRow, 3) = xItem
    .Cells(lRow, 4) = SKU
    .Cells(lRow, 5) = Val
    .Cells(lRow, 6) = Qty
    .Cells(lRow, 7) = Gross

    untuk yang mas bilang deklarasi itu dimna ya di tambahkannya

    awam masih mas dengan vba

  6. Caton

    Jul 18 Terverifikasi Indonesia + 17.741 Poin
    Di sunting 5 bulan yang lalu oleh Caton

    Mas @Agus789 ...

    Hampir seperti yang mas buat. Cuma itu untuk ambil nilai Gross dan Disc, tidak perlu dibuat 2 kali. Sekali saja, bisa sesudah perintah If ... Then, atau setelah baris Qty = ..., kayak gini misalnya :

    Sub GetData(ByVal x As Long)
        Dim sel As Range, rng As Range, SKU As Variant, Val As Variant, Qty As Variant
        Dim No As Long, y As Long, xItem As Double, lRow As Long
    
        Dim dDate As Double, dGross As Double, dDisc As Double
        Dim vArr As Variant
        Dim sTrx As String
    
        Set rng = Range("A1:A" & x)
        
        On Error Resume Next
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        For Each sel In rng
            With loadingBar
                process = Int(sel.Row * 100 / x)
                .Caption = "memproses baris ke " & sel.Row & " dari " & x
                .lblBar.Width = process * 3
                .lblBar.Caption = process & "%"
                DoEvents
            End With
            
            If InStr(sel, "PENJUALAN") Then
                No = No + 1
                y = 0
                
                vArr = Split(Replace(sel, "  ", "|"), "|")
                sTrx = vArr(UBound(vArr) - 1)
                dDate = CDate(vArr(UBound(vArr)))
            End If
            
            If IsNumeric(Left(sel, 8)) And Len(Trim(Left(sel, 8))) = 8 Then
                y = y + 1
                xItem = No + y / 100
                SKU = Left(sel, 8)
                Val = UBound(Split(sel, " "))
                Val = WorksheetFunction.Substitute(sel, " ", "|", Val)
                Val = Mid(sel, InStr(Val, "|"), 50)
                Qty = Left(sel.Offset(1), InStr(1, sel.Offset(1), "@") - 1) * 1
                
                vdata = Split(Replace(sel.Offset(1).Value2, "  ", "|"), "|")
                dGross = CDbl(Replace(vdata(UBound(vdata)), ",", ""))
                
                vdata = Split(Replace(sel.Offset(2).Value2, "  ", "|"), "|")
                dDisc = CDbl(Replace(vdata(UBound(vdata)), ",", ""))
                        
                lRow = Range("C" & Rows.Count).End(xlUp).Row + 1
                With ShTes
                    .Cells(lRow, 3) = xItem
                    .Cells(lRow, 4) = SKU
                    .Cells(lRow, 5) = Val
                    .Cells(lRow, 6) = Qty
                    .Cells(lRow, 7) = sTrx
                    .Cells(lRow, 8) = dGross
                    .Cells(lRow, 9) = dDisc
                    .Cells(lRow, 10) = dDate
                End With
            End If
        Next
        Err.Clear
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
    End Sub

    Demikian.

  7. ok mas @Caton data nya udah sesuai ni,

    terima kasih bnyak ya bantuannya

  8. Caton

    Jul 18 Terverifikasi Indonesia + 17.741 Poin

    Sama-sama mas @Agus789 ... :)

 

atau Mendaftar untuk ikut berdiskusi!