Mengambil nilai berdasarkan nama header

  1. 6 bulan yang lalu

    om @Caton
    bisa ngak kalo ngambil nilai perkolom berdasarkan nama header?

    saya punya contoh file .csv
    dibagian kolom "Remark Rekon RTPO" nah ini biasanya yang remark bisa ditambahkan "," jadi kalo saya ambil per xArray() pasti melenceng nilai setelahnya.

  2. Caton

    8 Mei 2018 Terverifikasi Indonesia + 12.574 Poin

    @Lexs194 ...

    Mengambil data berdasarkan Header dengan scripting yang mas gunakan saat ini membutuhkan banyak tambahan proses untuk memeriksa atau memilah kembali data yang diambil apabila terdapat kelebihan tanda pemisah (seperti tanda koma) seperti pada teks:

    "Solar Cell dan Battery, on going pengadaan genset fix by DMT"

    karena proses tidak bisa lagi hanya mengandalkan fungsi SPLIT untuk memisahkan data ke dalam array. Kemungkinan proses yang bisa diterapkan:

    — Menggunakan fungsi SPLIT sebagaimana script sebelumnya, kemudian memeriksa kembali dimensi array data apakah sesuai dengan dimensi array header. Jika tidak sama, maka periksa array data per elemen untuk mencari elemen data yang memiliki awalan tanda kutip ganda sebagai awal teks, dan selanjutnya mencari elemen data yang memiliki akhiran tanda kutip ganda sebagai akhir teks. Jika kedua elemen ditemukan, maka gabungkan elemen pertama sampai ke elemen terakhir menjadi satu elemen, kemudian pindahkan kembali ke dalam elemen yang sesuai (yakni pada posisi elemen pertama).

    — Data dibaca per baris dahulu. Kemudian gunakan fungsi INSTR untuk mencari tanda pemisah (tanda koma). Jika ditemukan tanda pemisahnya, periksa karakter selanjutnya apakah berupa tanda kutip ganda. Jika ya, cari tanda kutip ganda selanjutnya. Jika ditemukan tanda kutip ganda kedua, periksa apakah karakter selanjutnya adalah tanda koma. Jika ya, ambil bagian teks dimulai dari tanda kutip ganda pertama sampai tanda kutip ganda terakhir sebagai sebuah elemen array. Jika pada proses pencarian tanda pemisah tidak menemukan tanda tanda kutip ganda pada pemeriksaan karakter selanjutnya, maka bagian teks dari posisi indeks mulai sampai pada posisi tanda pemisah ditemukan dimasukkan ke dalam elemen array.

    Scriptnya bagaimana, silahkan diterjemahkan dan diimplementasikan sendiri.

    Daripada pusing harus memodifikasi ulang script yang sudah ada, saya sarankan sebaiknya data dari file CSV tersebut diimpor saja ke Excel (melalui ribbon DATA » FROM TEXT atau disusun scriptnya). Dengan demikian proses pengambilan data dapat dilakukan dengan memanfaatkan Header per kolom yang dihasilkan oleh Excel dari proses impor tersebut. Proses yang dimiliki Excel lebih baik dalam memisahkan teks seperti pada kasus di atas. Dan, scriptingnya akan menjadi lebih mudah karena data sudah dalam bentuk per kolom.

    Apabila proses impor file CSV tersebut ingin disusun script VBA-nya, bisa memanfaatkan fitur Record Macro untuk mengetahui proses yang dilakukan Excel. Sisa prosesnya mas ambil kembali dari scripting sebelumnya untuk digabungkan menjadi sebuah prosedur utuh.

    Itu saja yang bisa saya sampaikan saat ini. Mungkin ada rekan-rekan lainnya punya ide yang lebih baik atau contoh script atau solusi lainnya, silahkan...

    Demikian.

  3. masih bingung om @Caton

  4. Daripada pusing harus memodifikasi ulang script yang sudah ada, saya sarankan sebaiknya data dari file CSV tersebut diimpor saja ke Excel (melalui ribbon DATA » FROM TEXT atau disusun scriptnya). Dengan demikian proses pengambilan data dapat dilakukan dengan memanfaatkan Header per kolom yang dihasilkan oleh Excel dari proses impor tersebut. Proses yang dimiliki Excel lebih baik dalam memisahkan teks seperti pada kasus di atas. Dan, scriptingnya akan menjadi lebih mudah karena data sudah dalam bentuk per kolom.

    kalo filenya saya ubah ke format .xlsx
    cara ambil arraynya gmn soalnya kalo dibuka di notepad bahasanya jadi beruhabah aneh

  5. Caton

    8 Mei 2018 Terverifikasi Indonesia + 12.574 Poin

    Yang saya sarankan, file CSV-nya diimpor, bukan dikonversikan. Karena kalo sudah masuk ke salah satu Worksheet di Excel, proses pengolahan datanya khan tinggal dikerjakan di Excel langsung. Lagian mengapa lagi file dokumen Excel dibuka pake Notepad...?!

    Berikut saya berikan contoh script yang akan mengimpor data dari file CSV dengan pemisah tanda koma dan penentu sebuah teks menggunakan tanda petik ganda:

    Option Explicit
    
    Public Sub ImportCSV()
        Dim sFileName As String
        Dim lIdx As Long
    
        sFileName = vbNullString
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path & "\"
            .Filters.Clear
            .Filters.Add "Data Text Files", "*.csv"
            If .Show = True Then
                For lIdx = 1 To .SelectedItems.Count
                    sFileName = sFileName & .SelectedItems(lIdx) & "|"
                Next
                sFileName = Left$(sFileName, Len(sFileName) - 1)
            End If
        End With
    
        If Len(sFileName) Then
            lIdx = ThisWorkbook.Connections.Count
            With SheetTemp
                .Cells.Delete
                With .QueryTables.Add(Connection:="TEXT;" & sFileName, Destination:=[A1])
                    .Name = "DumpData"
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = 850
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote '+-- Karakter penanda teks
                    .TextFileConsecutiveDelimiter = False
                    .TextFileTabDelimiter = True
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = True '+-- Karakter pemisah 
                    .TextFileSpaceDelimiter = False
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            End With
            ThisWorkbook.Connections(lIdx + 1).Delete
            SheetTemp.QueryTables(1).Delete
        End If
    
    End Sub

    Salin dan tempel script di atas ke dalam modul standar. Perhatikan, notasi SheetTemp merupakan Worksheet Object. Jadi kalau mau ditempelkan di object Sheet1, maka ganti notasi SheetTemp dengan Sheet1.

    Setelah data diimpor ke sheet tujuan, langkah selanjutnya silahkan disusun sendiri. Intinya, proses pengambilan data dilakukan melalui pengulangan yang dilakukan mulai dari baris ke-2 (misalkan sel A2, dengan asumsi baris pertama adalah Header) sampai baris akhir data. Sedangkan untuk menentukan kolom mana yang datanya akan diproses, bisa dilakukan melalui pengujian teks per kolom pada baris pertama, atau langsung merujuk ke kolom tertentu (misalkan kolom R).

    Demikian.

  6. biasanya saya buka file .csv pake notepad untuk liat pemisah textnya om, kalo saya buka langsung dgn excel ngak ngerti cara liat pemisahnya.

    baik om @Caton saya coba2 dulu

  7. Caton

    9 Mei 2018 Terverifikasi Indonesia + 12.574 Poin
    Di sunting 6 bulan yang lalu oleh Caton

    Mas @Lexs194 ...

    Yang tidak saya pahami, jika ingin melihat field separator-nya, mengapa yang dibuka di Notepad adalah file Excel-nya, bukan file CSV-nya... :)

    Pada penjelasan awal, saya ingin mas @Lexs194 paham bahwa jika proses membaca data dari file CSV dilakukan secara berulang dengan melakukan proses parsing data per baris teks yang dibaca menggunakan fungsi SPLIT, maka ketentuan utamanya adalah setiap kolom data yang dibaca harus benar-benar terpisah sesuai tanda pemisahnya. Jadi jika dalam prosesnya kita menggunakan tanda koma sebagai pemisah antar kolom data atau data field-nya, maka proses akan mengalami kesalahan saat bertemu dengan teks seperti berikut:

    123, "Solar Cell dan Battery, on going pengadaan genset fix by DMT", 96.62

    Pada contoh teks tersebut, jika menurut ketentuan harusnya teks terpisah menjadi 3 kolom, kenyataannya teks akan terpisah menjadi 4 kolom seperti berikut:

    123 | "Solar Cell dan Battery | on going pengadaan genset fix by DMT" | 96.62

    Jadi bagaimana solusinya? Logika saya hanya melihat ada 2 kemungkinan modifikasi dari script VBA yang sudah pernah kita bahas sebelumnya:

    [1]. Menguji apakah dimensi baris data sama dengan dimensi baris header, misalkan algoritmanya:

    xHeader = SPLIT(TEXT_HEADER_A, ",")
    xArray = SPLIT(sBuffer, ",")
    
    If UBound(xHeader) <> UBound(xArray) Then
        '+--- Script untuk menguji elemen array xArray.
    End If

    [2]. Menguji setiap karakter pada baris data yang kita apakah ada karakter yang masuk kualifikasi teks, yakni jika ada 2 tanda petik ganda dalam teks tersebut. Sebagai contoh:

    Sub TesSaja()
        Dim sBuffer As String, sTempA As String, sTempB As String, sTempC As String
        Dim lPos1 As Long, lPos2 As Long
        Dim lIdx As Long
        Dim xArray
        
        sBuffer = "123, ""Solar Cell dan Battery, on going pengadaan genset fix by DMT"", 96.62"
        lPos1 = InStr(1, sBuffer, Chr$(34))
        If lPos1 > 0 Then
            lPos2 = InStr(lPos1 + 1, sBuffer, Chr$(34))
            If lPos2 > 0 Then
                sTempA = Mid$(sBuffer, 1, lPos1 - 1)
                sTempB = Mid$(sBuffer, lPos2 + 1, 1000)
                sTempC = Mid$(sBuffer, 1, lPos2)
                Debug.Print "[1]  "; sBuffer
                sBuffer = Replace(sTempC, Chr$(44), Chr$(250), lPos1)
                sBuffer = Replace(sBuffer, Chr$(34), vbNullString, 1)
                Debug.Print "[2]  "; sBuffer
                sBuffer = sTempA & sBuffer & sTempB
                Debug.Print "[3]  "; sBuffer
            End If
        End If
        Debug.Print
        xArray = Split(sBuffer, Chr$(44))
        If UBound(xArray) > -1 Then
            For lIdx = 0 To UBound(xArray)
                sTempA = Trim$(xArray(lIdx))
                If InStr(1, sTempA, Chr$(250)) > 0 Then
                    xArray(lIdx) = Replace(sTempA, Chr$(250), Chr$(44))
                End If
                If lIdx < UBound(xArray) Then
                    Debug.Print Trim$(xArray(lIdx)) & " | ";
                Else
                    Debug.Print Trim$(xArray(lIdx))
                End If
            Next
        End If
    End Sub

    Perintah Debug.Print pada script di atas akan menghasilkan (lihat pada jendela Immediate):

    [1]  123, "Solar Cell dan Battery, on going pengadaan genset fix by DMT", 96.62
    [2]  Solar Cell dan Batteryú on going pengadaan genset fix by DMT
    [3]  123, Solar Cell dan Batteryú on going pengadaan genset fix by DMT, 96.62
    
    123 | Solar Cell dan Battery, on going pengadaan genset fix by DMT | 96.62

    Script pada solusi kedua ini tentunya jika akan digunakan masih membutuhkan banyak penyesuaian dan penambahan script, karena:

    — a). belum dapat digunakan untuk memeriksa apakah baris data memiliki lebih dari 1 kualifikasi teks. Contoh pada teks:

    123, "Solar Cell dan Battery, on going pengadaan genset fix by DMT", 96.62, "TEXTA, TEXTB", 1000

    yang jika script dieksekusi maka akan menghasilkan:

    123 | Solar Cell dan Battery, on going pengadaan genset fix by DMT | 96.62 | "TEXTA | TEXTB" | 1000

    — b). pada saat baris data tidak memenuhi kualifikasi teks (yakni jika tidak ada 2 tanda petik ganda), maka akan terjadi kesalahan kembali. Contoh untuk teks seperti berikut:

    123, "Solar Cell dan Battery, on going pengadaan genset fix by DMT, 96.62

    jika script dieksekusi maka akan menghasilkan:

    123 | "Solar Cell dan Battery | on going pengadaan genset fix by DMT | 96.62

    Kembali hasilnya tidak sesuai. Dengan contoh teks tersebut, kesalahan juga terjadi saat kita mengimpor data menggunakan fitur impor (DATA » FROM TEXT) pada Excel oleh karena kualifikasi sebuah teks tidak terpenuhi.

    Jika tidak ingin melakukan perubahan besar pada script yang sudah digunakan, tentunya yang harus mas @Lex194 lakukan adalah memeriksa terlebih dahulu file CSV-nya, dan mengubah baris data yang memiliki kualifikasi sebuah teks agar dapat diloading oleh script yang sudah ada. Contohnya mengubah teks:

    "Solar Cell dan Battery, on going pengadaan genset fix by DMT"

    menjadi:

    "Solar Cell dan Battery: on going pengadaan genset fix by DMT"

    namun pastinya akan melelahkan jika ada banyak baris data yang akan diproses. Jadi silahkan ditentukan solusi mana yang akan mas gunakan.

    Untuk mengolah data yang kita impor dari CSV ke Worksheet Excel sebagaimana yang sudah saya contohkan di atas, ada banyak cara yang dapat dilakukan, diantaranya:

    [1]. Mengisi variabel array dengan range data per baris, contoh:

    xArray = SheetTemp.Range("A2:BF2").Value

    Catatan: dengan teknik ini, indeks elemen terbawah adalah 1, bukan 0. Dan xArray akan menjadi array 2 dimensi. Sehingga untuk mengaksesnya menggunakan xArray(RowIdx, ColIdx) dimana untuk contoh di atas, karena hanya dibaca per baris maka RowIdx = 1 sedangkan ColIdx merujuk ke indeks kolom.

    [2]. Membaca isi per sel:

    Redim xArray(lCols - 1)
    For lRow = 2 To lRows
        For lCol = 0 To lCols - 1
            xArray(lCol) = SheetTemp.Cells(lRow, lCol +1)
        Next
    Next

    Catatan: lRows adalah indeks baris data terakhir dari SheetTemp, misalkan baris data terakhir ada pada range A3:BF3, maka lRow = 3. Sedangkan lCols adalah indeks kolom terakhir, misalkan kolom BF yang sama dengan kolom ke-58.

    Demikian saja yang bisa saya jelaskan.

  8. iya om @Caton kemarin untungnya yang masalah cuma beberapa baris dengan remark yang sama namanya jadi gampang diubah komanya. tapi kalo banyak ya repot juga haha

    saya nyerah om kalo dibikin split2 lagi tambah bingung ntar saya.

    Redim xArray(lCols - 1)
    For lRow = 2 To lRows
        For lCol = 0 To lCols - 1
            xArray(lCol) = SheetTemp.Cells(lRow, lCol +1)
        Next
    Next


    penggunannya gmn ya om sumpah ngak ngerti. saya baru coba kena error soalnya

  9. Caton

    10 Mei 2018 Terverifikasi Indonesia + 12.574 Poin
    Di sunting 6 bulan yang lalu oleh Caton

    ... penggunannya gmn ya om sumpah ngak ngerti ...

    Ya repot urusannya kalau mas @Lexs194 tidak mengerti apa yang harus dilakukan... (^_^)/ Coba pelajari dan modifikasi kembali perbaikan dari script yang mas susun berikut:

    Public Sub copyFile()
        Dim xArray
        Dim lRow As Long, lCols As Long, lRows As Long, lCol, x As Long
        Dim DataRange As Range, cell As Range
        
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ImportCSV
        
        lRows = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
        lCols = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
        
        ReDim xArray(lCols - 1)
        For lRow = 2 To lRows
            For lCol = 0 To lCols - 1
                xArray(lCol) = Sheet2.Cells(lRow, lCol + 1)
            Next
            '+--- Di sini isi baris pemrosesan data pada xArray,
            '+--- bisa dengan cara memanggil prosedur atau
            '+--- scriptnya dibuat langsung pada blok ini.
        Next
        
        With Application
        .ScreenUpdating = True
        .EnableEvents = True
        End With
    End Sub

    Pada script di atas, pada baris yang saya berikan komentar, silahkan susun script selanjutnya untuk memproses array xArray sebagaimana yang mas inginkan. Mas bisa menggunakan cara memanggil prosedur khusus dengan array xArray sebagai argumennya, misalkan:

    Public Sub CopyFile()
    ...
    For lRow = 2 To lRows
        For lCol = 0 To lCols - 1
            xArray(lCol) = Sheet2.Cells(lRow, lCol + 1)
        Next
        ProcessData xArray
    Next
    ...
    End Sub
    
    Private Sub ProcessData(Data)
        Dim lIdx As Long
        
        '+--- Tes: Periksa hasilnya pada Immediate WIndow.
        For lIdx = 0 To UBound(Data)
            Debug.Print Data(lIdx)
        Next
        '+--- Ganti baris script di atas dengan scripting
        '+--- proses data sebenarnya.
    
    End Sub

    atau langsung disusun di dalam blok tersebut, contoh:

    Public Sub CopyFile()
    ...
    For lRow = 2 To lRows
        For lCol = 0 To lCols - 1
            xArray(lCol) = Sheet2.Cells(lRow, lCol + 1)
        Next
    
        On Error Resume Next
        If UBound(xArray) > -1 Then        
            ...
        End If
    
    Next
    ...
    End Sub

    Demikian.

  10. om @Caton
    saya coba pake debug.print tapi ngak muncul data, apa memang belum keambil ya data di sheet2

  11. Caton

    11 Mei 2018 Terverifikasi Indonesia + 12.574 Poin

    @Lexs194 ...

    ... saya coba pake debug.print tapi ngak muncul data, apa memang belum keambil ya data di sheet2 ..

    Datanya sudah tersimpan ke dalam array xArray. Perintah Debug.Print pada dasarnya hanya dapat digunakan untuk menampilkan hasil eksekusi dari sebuah sebuah perintah atau isi dari sebuah variabel, bukan objek. Pada baris script yang mas gunakan berikut:

    Debug.Print xArray

    otomatis akan menghasilkan error Type Mismatch dikarenakan xArray merupakan Array Object. Adapun mengapa tidak tampil hasilnya, itu dikarenakan ada baris perintah On Error Resume Next yang akan menyembunyikan semua pesan kesalahan yang terjadi setelah perintah tersebut dieksekusi, seperti pada baris:

    On Error Resume Next
    If UBound(xArray) > -1 Then
        With Sheet1
            'ngak muncul data
            Debug.Print xArray             
        End With
    End If

    Untuk menampilkan isi dari objek xArray, maka yang harus dilakukan adalah mengambil elemen dari objek array tersebut yang diidentifikasi melalui indeks elemennya. Sehingga contoh script yang dapat digunakan adalah seperti berikut:

    Debug.Print xArray(17)

    Maaf, tapi sangat saya sarankan mas @Lexs194 terlebih dahulu mempelajari object-object pada VBE, Process Flow dari sebuah program dan sintaks dari fungsi-fungsi object pada VBA. Salin tempel (copas) dari script yang sudah ada akan lebih aman saat kita paham hal-hal tersebut, karena kita bisa mengetahui posisi yang tepat untuk menempel script, tahu apa saja penyesuaian yang harus atau yang dapat dilakukan, dan lebih mudah memahami apa yang sedang disusun.

    Berkut saya berikan contoh perbaikan dari masalah script yang mas tanyakan. Modifikasi script berikut sesuai dengan yang diinginkan pada blok yang saya komentari.

    Public Sub CopyFile()
        Dim lCol As Long, lRow As Long, lCols As Long, lRows As Long
        Dim lIdx As Long, lRowIndex As Long
        Dim xArray
            
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ImportCSV
        
        Sheet2.Activate
        lRows = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
        lCols = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
            
        lRowIndex = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1
        For lRow = 2 To lRows
            With Sheet2
                xArray = .Range(.Cells(lRow, 1), .Cells(lRow, lCols)).Value
                If UBound(xArray) > -1 Then
                    With Sheet1
                        '+-- Start Block!
                        '+-- Sesuaikan dengan proses aktual yang diinginkan.
                        .Cells(lRowIndex, 1) = xArray(1, 1)
                        .Cells(lRowIndex, 2) = xArray(1, 2)
                        .Cells(lRowIndex, 3) = xArray(1, 3)
                        .Cells(lRowIndex, 4) = xArray(1, 4)
                        .Cells(lRowIndex, 5) = xArray(1, 5)
                        .Cells(lRowIndex, 6) = xArray(1, 6)
                        
                        lRowIndex = lRowIndex + 1
                        '+-- End Block!
                    End With
                    Erase xArray
                End If
            End With
        Next
    
        With Application
        .ScreenUpdating = True
        .EnableEvents = True
        End With
    End Sub

    Demikian.

  12. terima kasih om @Caton
    dicoba dulu.

 

atau Mendaftar untuk ikut berdiskusi!