Bantu donk mempersingkat proses

  1. 5 tahun lalu

    All bantu ada proses d Excel renamenya bisa gak proses d peringkat biar lgsg hasil sesuai dengan makro gabung1

    Utk attachment file txt itu hasil dr makro opennotepad2
    Bagaimana klo hasil dr makro opennotepad2 d atas dan bawah hasil txt di tulis MAPtglhariini yg bawah MAPtglharinijumlahjumlahdata

    Hasilnya seperti ini
    MAP20181108
    123
    124
    126
    MAP201811083

  2. Caton

    9 Nov 2018 Terverifikasi Indonesia + 20.101 Poin
    Di sunting 5 tahun lalu oleh Caton

    @Gumay ... bisa gak proses d peringkat biar lgsg hasil sesuai dengan makro gabung1 ... Bagaimana klo hasil dr makro opennotepad2 d atas dan bawah hasil txt di tulis MAPtglhariini ...

    Script berikut saya ambil sedikit dari diskusi di sini dengan tujuan agar tidak perlu mengulang-ulang proses inisialisasi objek FSO. Jadi script berikut bisa digabung dalam satu modul. Atau bisa juga dibuat terpisah. Scriptnya:

    Option Explicit
    
    Public m_xFSO As Object
    
    Private Function InitFSO() As Boolean
        On Error Resume Next
        
        InitFSO = True
        If m_xFSO Is Nothing Then
            Set m_xFSO = CreateObject("Scripting.FileSystemObject")
            If Err <> 0 Then InitFSO = False
        End If
        
        Err.Clear: On Error GoTo 0
        
    End Function
    
    Sub GabungData()
        Dim sResult As String, sPath As String
        Dim xlCell As Range, xlData As Range
        Dim lRow As Long
        
        On Error Resume Next
        
        sPath = Sheet1.Range("M2")
        If Right$(sPath, 1) <> "\" Then
            sPath = sPath & "\"
        End If
        
        Set xlData = Sheet2.Range("A2:H6")
        For Each xlCell In Sheet1.Range("A2:A10000")
            sResult = vbNullString
            If Len(xlCell) Then
                With WorksheetFunction
                    lRow = .Match(xlCell, xlData.Columns(1), 0)
                    If Err = 0 Then
                        sResult = sResult & .Index(xlData, lRow, 3) & Chr$(32)
                        sResult = sResult & .Index(xlData, lRow, 4)
                        sResult = sPath & sResult & "\"
                        Sheet1.Cells(xlCell.Row, "H") = sResult
                    Else
                        Err.Clear
                    End If
                End With
            Else
                Exit For
            End If
        Next
    End Sub
    
    Sub Simpan()
        Dim sFileName As String
        Dim xFile As Object
        Dim xlCell As Range
        Dim lCount As Long
        
        On Error GoTo errHandler
        
        sFileName = Sheet1.Range("M2")
        If Right$(sFileName, 1) <> Chr$(92) Then sFileName = sFileName & Chr$(92)
        sFileName = sFileName & Sheet1.Range("M3") & ".TXT"
        
        Call InitFSO
        
        With m_xFSO
            '+-- Jika file tidak ada, maka buat file. Jika
            '+-- file sudah ada, maka tambahkan data baru!
            '+-- Jika ingin file hanya sebagai otuput saja
            '+-- atau data akan ditimpa, maka gunakan mode
            '+-- ForWriting.
            Set xFile = .OpenTextFile(sFileName, ForAppending, True, False)
            
            With xFile
                lCount = 0
                .WriteLine "MAP" & Format$(Now(), "yyyymmdd")
                For Each xlCell In Sheet1.Range("A2:A10000")
                    If Len(xlCell) = 0 Then Exit For
                    .WriteLine xlCell
                    lCount = lCount + 1
                Next
                .WriteLine "MAP" & Format$(Now(), "yyyymmdd") & lCount
                .Close
            End With
        End With
        
    errHandler:
        If Err Then
            MsgBox "Proses gagal. Kesalahan #" & Err.Number & vbCrLf & _
                Err.Description, vbCritical
        End If
        Err.Clear: On Error GoTo 0
    End Sub

    Demikian.

  3. Terima kasih mas

  4. Om eror berikut knp ya

  5. Caton

    12 Nov 2018 Terverifikasi Indonesia + 20.101 Poin
    Di sunting 5 tahun lalu oleh Caton

    @Gumay ... Om eror berikut knp ya ...

    Ganti ForAppending dengan angka 8. Atau jika ingin mengetahui properti dan prosedur dalam File System Object, lakukan proses seperti berikut:

    sample.png

    [1]. Klik menu Tools » References ...
    [2]. Pada jendela References, pilih dan centang objek Microsoft Scripting Runtime.
    [3]. Klik Ok.

    Demikian.

  6. Terima kasih mas

 

atau Mendaftar untuk ikut berdiskusi!