formula vba tidak bekerja dengan baik setelah ganti formula?

  1. 6 bulan yang lalu

    saya mencari formula yang lebih baik untuk menghitung nilai yang ada di cell L16 - L29 dan menampilkan hasilnya di antara cell m16 sd dh29
    Pada awalnya gini saya membuat hanya mengetikan nama di cell L16-L29 secara manual sesuai data nama yang tercantum di cell b3
    lalu hasilnya di tampilkan di sebelahnya
    misal hasil l16 di tampilkan di M16-dh16 , hasil l17, di m17-dh17
    misal nulis nama john maka dari m16-dh16 akan menjadi
    JOHN (not case sensitive) then the result will be like:
    J O O O O O H H H H H H N N N N N N N N N N J O O O O O O H H H H H H H H H ..... etc (starts at m 16 and stops at dh16)

    letter grade:
    a, j, s = 1 cell
    b, k, t = 2 cell
    c, l, u 3 cell
    d, m, v = 4 cell
    e, n, w = 5 cell
    f, o, x = 6 cell
    g, p, y = 7 cells
    h, q, z = 8 cell
    r, i = 9 cell

    untuk mendapatkan hasil itu saya pakai code

    Sub Fill_columns(wordStr, Srow)
    
    Dim tblRng As Range
    Dim i As Integer, j As Integer, n As Integer, c As Integer
    
    Application.ScreenUpdating = False
    
    Scol = 13
    nc = Len(wordStr)
    c = 1
    
    loopagain:
        For i = 1 To nc
            letter = UCase(Mid(wordStr, i, 1))
            n = Application.VLookup(letter, Range("tblRng"), 2, 0)
            For j = 1 To n
                Cells(Srow, Scol + c - 1) = letter
                c = c + 1
                If c > 100 Then GoTo exitsub
            Next j
        Next i
    GoTo loopagain:
    
    exitsub:
    Application.ScreenUpdating = True
    
    End Sub


    The above fills in the columns

    Use a named range "TblRng" which is on Sheet2

    Private Sub Worksheet_Change(ByVal Target As Range) 'Do nothing if more than one cell is changed or content deleted If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub If Not Intersect(Target, Range("L16:L29")) Is Nothing Then 'Stop any possible runtime errors and halting code On Error Resume Next Application.EnableEvents = False Call Fill_columns(Target.Value, Target.Row) 'Turn events back on Application.EnableEvents = True 'Allow run time errors again On Error GoTo 0 End If End Sub

    dan formulanya berhasil dengan cara mengetikan Nama yang di cari nilainya di cell L16-L29.

    Masalahnya ketika saya buat formula baru supaya ga ribet ngetik satu satu di cell L16-L29 dan langsung satu kali klik di cell B3
    Hasil code vba ga terupdate secara otomatis, mesti double klick dulu di cell yang ingin saya cari nilainya.
    nah kira kira adakah kode/formula yang lebih sederhana supaya hasil di cell L16-L29 tetap bisa di tampilkan Dan berjalan semestinya di antara cell m16 - dh29
    tanpa harus repot repot ngetik satu satu data di Rentang cell L16-L29?
    saya mau ganti code fill_column karna udah ga berhubungan.
    mohon bantuannya gan. saya kurang paham soal vba macro.

    @jeccobeard

    terlampir file yang sudah saya edit sana sini :D. setelah ketik nama tekan tombol "OK"
    sejauh ini saya coba fine-fine aja, hanya saja saya gak tau apakah hitunganya benar atau ngak (^_^)/
    note : formula dibelakang tombol jangan di hapus ya

    mungkin mas @Caton atau teman2 lain yang sekiranya punya solusi lebih baik mari ikut nimbrung

  2. manweljs_

    17 Mei 2018 Terverifikasi Jawaban Terpilih + 5.718 Poin
    Di sunting 6 bulan yang lalu oleh manweljs_

    @jeccobeard

    terlampir file yang sudah saya edit sana sini :D. setelah ketik nama tekan tombol "OK"
    sejauh ini saya coba fine-fine aja, hanya saja saya gak tau apakah hitunganya benar atau ngak (^_^)/
    note : formula dibelakang tombol jangan di hapus ya

    mungkin mas @Caton atau teman2 lain yang sekiranya punya solusi lebih baik mari ikut nimbrung

  3. Di sunting 6 bulan yang lalu oleh jeccobeard

    @manweljs_ @jeccobeard

    terlampir file yang sudah saya edit sana sini :D. setelah ketik nama tekan tombol "OK"
    sejauh ini saya coba fine-fine aja, hanya saja saya gak tau apakah hitunganya benar atau ngak (^_^)/
    note : formula dibelakang tombol jangan di hapus ya

    mungkin mas @Caton atau teman2 lain yang sekiranya punya solusi lebih baik mari ikut nimbrung

    bro kalo namayang di ketik
    1 frase saja lalu klik search
    kok excel jadi not responding ya?
    misal ketik nama : gogon
    apa di pc saya saja, ms.excel 2007 window 7

  4. misal di B3 tulis nama raditya lalu serch maka file excel tiba tiba not responding

  5. @jeccobeard misal di B3 tulis nama raditya lalu serch maka file excel tiba tiba not responding

    tapi kalo nulis nama seperti
    Andika) (spasi) ..
    itu work ya?
    apa vbanya di rancang buat lebih dari satu frase, apa ada yg error broh

  6. Di sunting 6 bulan yang lalu oleh manweljs_

    @jeccobeard

    modifikasi skripnya untuk Fill_columns kembalikan seperti semula

    Sub Fill_columns(wordStr, Srow)
    
    Dim tblRng As Range
    Dim i As Integer, j As Integer, n As Integer, c As Integer
    
    Application.ScreenUpdating = False
    
    Scol = 13
    nc = Len(wordStr)
    c = 1
    
    loopagain:
        For i = 1 To nc
            letter = UCase(Mid(wordStr, i, 1))
            n = Application.VLookup(letter, Range("tblRng"), 2, 0)
            For j = 1 To n
                Cells(Srow, Scol + c - 1) = letter
                c = c + 1
                If c > 100 Then GoTo exitsub
            Next j
        Next i
    GoTo loopagain:
    
    exitsub:
    Application.ScreenUpdating = True
    
    End Sub

    untuk fWord :

    Sub fWord(ByVal i As Long)
    Application.ScreenUpdating = False
    
        If Cells(3, 3).Value = 1 Then
            Range("L16").Value = Cells(3, 2)
        Else
            For i = 1 To 14
                myFormula = "=findword($B$3," & i & ")"
                Range("L" & 15 + i) = myFormula
            Next i
            Range("L16:L29").Copy
            Range("L16").PasteSpecial xlPasteValues
        End If
        
    Range("B3").Select
    Application.CutCopyMode = False
    
    End Sub

    dan untuk OK :

    Sub OK()
    Dim target As Range
    On Error GoTo ErrorHandler
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        Range("L16:DH29").ClearContents
        Call fWord(1)
        For i = 1 To Cells(3, 3).Value
            Set target = Range("L" & 15 + i)
            Call Fill_columns(target.Value, target.Row)
        Next i
        
    Call calc_Scores
    
    ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

    dan untuk event call Fill_columns pada Worksheet_Change bisa dihapus.

  7. Di sunting 6 bulan yang lalu oleh jeccobeard

    @manweljs_ @jeccobeard

    modifikasi skripnya untuk Fill_columns kembalikan seperti semula

    Sub Fill_columns(wordStr, Srow)
    
    Dim tblRng As Range
    Dim i As Integer, j As Integer, n As Integer, c As Integer
    
    Application.ScreenUpdating = False
    
    Scol = 13
    nc = Len(wordStr)
    c = 1
    
    loopagain:
        For i = 1 To nc
            letter = UCase(Mid(wordStr, i, 1))
            n = Application.VLookup(letter, Range("tblRng"), 2, 0)
            For j = 1 To n
                Cells(Srow, Scol + c - 1) = letter
                c = c + 1
                If c > 100 Then GoTo exitsub
            Next j
        Next i
    GoTo loopagain:
    
    exitsub:
    Application.ScreenUpdating = True
    
    End Sub

    untuk fWord :

    Sub fWord(ByVal i As Long)
    Application.ScreenUpdating = False
    
        If Cells(3, 3).Value = 1 Then
            Range("L16").Value = Cells(3, 2)
        Else
            For i = 1 To 14
                myFormula = "=findword($B$3," & i & ")"
                Range("L" & 15 + i) = myFormula
            Next i
            Range("L16:L29").Copy
            Range("L16").PasteSpecial xlPasteValues
        End If
        
    Range("B3").Select
    Application.CutCopyMode = False
    
    End Sub

    dan untuk OK :

    Sub OK()
    Dim target As Range
    On Error GoTo ErrorHandler
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        Range("L16:DH29").ClearContents
        Call fWord(1)
        For i = 1 To Cells(3, 3).Value
            Set target = Range("L" & 15 + i)
            Call Fill_columns(target.Value, target.Row)
        Next i
        
    Call calc_Scores
    
    ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub


    udah saya edit. kaya git bukan ya?
    dan untuk event call Fill_columns pada Worksheet_Change bisa dihapus.

    kalo formula yang di bawah Pinnacles
    sepertinya jadi error ya bro. cycle
    jadi ga berurutan itu kenapa ya?

    apa ada yg ke hapus ? itu code saya pelajari dari cara buat pinnacles
    pas di ganti/milih nilai timenya di cell. jadi keluar jalur

    '------------------------------------------------------------------------
    'event khusus untuk life cycle
    '------------------------------------------------------------------------
    
    t1a = "M35:AM35"
    t1b = "AN35:BN35"
    t1c = "B035:DH35"
    
    t2a = "M35:AL35"
    t2b = "AM35:BM35"
    t2c = "BN35:DH35"
    
    t3a = "M35:AK35"
    t3b = "AL35:BL35"
    t3c = "BM35:DH35"
    
    t4a = "M35:AJ35"
    t4b = "AK35:BT35"
    t4c = "BU35:DH35"
    
    t5a = "M35:AR35"
    t5b = "AS35:BS35"
    t5c = "BT35:DH35"
    
    t6a = "M35:AQ35"
    t6b = "AR35:BR35"
    t6c = "BS35:DH35"
    
    
    t7a = "M35:AP35"
    t7b = "AQ35:BQ35"
    t7c = "BR35:DH35"
    
    
    t8a = "M35:AO35"
    t8b = "AP35:BP35"
    t8c = "BQ35:DH35"
    
    
    t9a = "M35:AN35"
    t9b = "AO35:BO35"
    t9c = "BP35:DH35"
    
    
    
    
    With Sheet1
    'time 1
    If Sheet1.Cells(6, 4).Value = 1 Then
     Range(t1a) = "=Cycle1"
     Range(t1b) = "=Cycle2"
     Range(t1c) = "=Cycle3"
    
    End If
    'time 2
    If Sheet1.Cells(6, 4).Value = 2 Then
     Range(t2a) = "=Cycle1"
     Range(t2b) = "=Cycle2"
     Range(t2c) = "=Cycle3"
    
    End If
    'time 3
    If Sheet1.Cells(6, 4).Value = 3 Then
     Range(t3a) = "=Cycle1"
     Range(t3b) = "=Cycle2"
     Range(t3c) = "=Cycle3"
    
    End If
    'time 4
    If Sheet1.Cells(6, 4).Value = 4 Then
     Range(t4a) = "=Cycle1"
     Range(t4b) = "=Cycle2"
     Range(t4c) = "=Cycle3"
    
    End If
    'time 5
    If Sheet1.Cells(6, 4).Value = 5 Then
     Range(t5a) = "=Cycle1"
     Range(t5b) = "=Cycle2"
     Range(t5c) = "=Cycle3"
    
    End If
    'time 6
    If Sheet1.Cells(6, 4).Value = 6 Then
     Range(t6a) = "=Cycle1"
     Range(t6b) = "=Cycle2"
     Range(t6c) = "=Cycle3"
    
    End If
    'time 7
    If Sheet1.Cells(6, 4).Value = 7 Then
     Range(t7a) = "=Cycle1"
     Range(t7b) = "=Cycle2"
     Range(t7c) = "=Cycle3"
    
    End If
    'time 8
    If Sheet1.Cells(6, 4).Value = 8 Then
     Range(t8a) = "=Cycle1"
     Range(t8b) = "=Cycle2"
     Range(t8c) = "=Cycle3"
    
    End If
    'time 9
    If Sheet1.Cells(6, 4).Value = 9 Then
     Range(t9a) = "=Cycle1"
     Range(t9b) = "=Cycle2"
     Range(t9c) = "=Cycle3"
    
    End If
    End With
    
    

    apa karena BO35 JADI B035 jadi keluar jalur ya

  8. Di sunting 6 bulan yang lalu oleh manweljs_

    @jeccobeard

    apakah yang dimaksud adalah saat time adalah 1 ?

    jika itu yang dimaksud maka ya itu betul, mungkin saat menulis BO ada miss sehingga menjadi B0 (nol). kan keyboarnya dekat tuh :D

    saya lihat untuk life cycle time 4 dan 5 keatas ada lompatan yang significant yaa, saya masih kurang paham disitu. seandainya polanya seperti pinnacle mungkin skripnya bisa lebih singkat

 

atau Mendaftar untuk ikut berdiskusi!