mengupdate data dengan 2 kreteria

  1. 11 bulan yang lalu

    para suhu mohon pencerahannya mengenai scrip di bawah ini dimana
    1.sheet "form" cell A1 adalah jenis material kayu
    2. sheet "form" cell A3 adalah no batch proses

    masalahnya ketika saya mau update data yang salah untuk paste spesial tidak berjalan,

    Sheets("form").Select
    Range("a:a").Select
    Selection.Copy

    Dim rngX As Range

    Sheets("form").Select
    Set rngX = Worksheets("DATABASE").Range("1:10000").Find(Worksheets("form").Range("A1"), After:=Range("A3"), lookat:=xlPart)

    If Not rngX Is Nothing Then
    Sheets("DATABASE").Select
    Range(rngX.Address).Select

    'Past data changes
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("input").Select
    MsgBox "Row Updated"

    terima kasih

  2. 10 bulan yang lalu

    Caton

    6 Des 2017 Terverifikasi Indonesia + 12.014 Poin
    Di sunting 10 bulan yang lalu oleh Caton

    Sayangnya tidak ada penjelasan tidak berjalan itu seperti apa. Namun jika yang dimaksud tidak berjalan itu terjadi karena kesalahan seperti pada gambar berikut:

    Shoot004.png

    maka hal itu terjadi karena jumlah sel atau ukuran range yang disalin lebih banyak atau lebih besar dari ukuran sel atau range tujuan. Coba lakukan secara manual, sorot (seleksi) kolom A pada sheet FORM dengan mengklik header kolom A, kemudian salin (Copy). Kemudian pilih salah satu sel pada kolom berbeda (misalkan sel B5) dan tempelkan (Paste As Values). Lihat apa yang terjadi. Excel akan menampilkan pesan kesalahan yang sama.

    Sheets("form").Select
    Range("a:a").Select
    Selection.Copy

    Perintah di atas akan membuat seluruh baris pada kolom A disorot (dipilih). Untuk Excel 2007 ke atas, artinya pilih seluruh sel dimulai dari sel A1 sampai dengan sel A1048576. Jika kita menempelkan sel atau range yang telah disalin tersebut pada sel B5, artinya hanya 1.048.572 sel yang dapat ditempelkan. Kurang 4 sel lagi... Kecuali range tujuan dimulai dari baris pertama (misalkan B1).

    Mungkin demikian masalahnya... ;)

  3. terima kasih responnya @Caton , sel a1 dan a3 adalah identitas yang akan di cari, misal cell A1 = kayu kamper 46 dan cell A3= proses ke 10. dimana ada data yang salah atau belum dimasukan dan akan di perbaiki/ditambahkan. setelah data di panggil dari database kekurangan tersebut di isi. dan macro di atas berfungsi untuk mencari data kayu kamper 46 proses ke 10 di data base untuk di ganti dengan data yang telah di lengkapi atau di koreksi kesalahannya.

  4. kelanjutan dari macro di atas jika data baru adalah sebagai berikut

    Sub Save()


    'Copy data from rekam a sheet
    Application.ScreenUpdating = False

    Sheets("form").Select
    Range("a:a").Select
    Selection.Copy

    Dim rngX As Range

    Sheets("form").Select
    Set rngX = Worksheets("DATABASE").Range("1:10000").Find(Worksheets("form").Range("A1"), After:=Range("A3"), lookat:=xlPart)

    If Not rngX Is Nothing Then
    Sheets("DATABASE").Select
    Range(rngX.Address).Select

    'Past data changes
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("input").Select
    MsgBox "Row Updated"


    Else

    'Copy Macro
    Sheets("form").Select
    Range("a:a").Offset(0, 0).Select
    Selection.Copy

    Sheets("database").Select
    Worksheets("DATABASE").Cells(Rows.Count, "A").End(xlUp).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=False
    'ActiveSheet.Paste
    ActiveCell.Offset(1).EntireColumn.Insert

    Sheets("input").Select
    Range("L3").ClearContents
    MsgBox "Penyalinan berhasil!", vbInformation, "Informasi"


    End If

  5. jika untuk 1 kreteria formula tersebut dapat berfungi, misalkan di data base hanya kayu kamper 46 saja maka yang di jadikan patokan hanya no proses misal proses ke 10. namun jika di data base memiliki jenis material kayu, 1. kamper 46 dan dan 64 dengan urutan no proses yang berbeda tidak berjalan.

  6. jika hanya parameter proses dan jenis kayu yang sama (kamper 46) dalam database saya script dibawah ini. namun jika saya memasukan jenis kayu yang berbeda (kamper 64) maka data dari kamper 46 dengan batch yang sama akan di ganti dengan kamper 64. padahal harapan saya data kamper 46 dengan batch tersebut tetap ada.

    'Copy data from rekam a sheet
    Application.ScreenUpdating = False

    Sheets("form").Select
    Range("a:a").Select
    Selection.Copy

    Dim rngX As Range

    Sheets("form").Select
    Set rngX = Worksheets("DATABASE").Range("1:1").Find(Worksheets("form").Range("a1"), lookat:=xlPart)

    If Not rngX Is Nothing Then
    Sheets("DATABASE").Select
    Range(rngX.Address).Select

    'Past data changes
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("input").Select
    MsgBox "Row Updated"

    Else

    'Copy Macro
    Sheets("form").Select
    Range("a:a").Offset(0, 0).Select
    Selection.Copy

    Sheets("database").Select
    Worksheets("DATABASE").Cells(Rows.Count, "A").End(xlUp).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=False
    'ActiveSheet.Paste
    ActiveCell.Offset(1).EntireColumn.Insert

    Sheets("input").Select
    MsgBox "Penyalinan berhasil!", vbInformation, "Informasi"

  7. Di sunting 10 bulan yang lalu oleh Fujiansyah92

    bisa lampirkan file terkait mas @absetiawan18 ... biar lebih jelas persoalannya.

    mungkin jika filenya ada rekan rekan disini bisa memberi solusinya....

  8. Caton

    7 Des 2017 Terverifikasi Indonesia + 12.014 Poin

    @Fujiansyah92 bisa lampirkan file terkait mas @absetiawan18 ... biar lebih jelas persoalannya. mungkin jika filenya ada rekan rekan disini bisa memberi solusinya....

    Saya setuju dengan mas @Fujiansyah92 ... :) Baris kode yang mas @Absetiawan18 sampaikan di atas tidak akan banyak membantu rekan-rekan dalam melacak masalahnya. Setidaknya, jika hanya mengandalkan prediksi, saya sendiri hanya bisa memprediksi masalahnya sebagaimana yang telah saya utarakan di atas. Meski saat ini saya melihat sudah ada perubahan kode VBA-nya khususnya dari baris:

    Set rngX = Worksheets("DATABASE").Range("1:10000").Find( ... )

    menjadi:

    Set rngX = Worksheets("DATABASE").Range("1:1").Find( ... )

    sehingga kemungkinan kesalahan berkurang. Namun untuk memahami proses sebenarnya, akan lebih baik jika bisa dilakukan debugging (pelacakan kesalahan) terhadap baris kodenya secara langsung... ^_^;

  9. macro proses kayu.xlsm filenya

  10. Saya buat script baru sepert ini :

    Sub NewSave()
    Dim rngX  As Range
    Dim strdata1, strdata2
    
    'Find with multiple criteria
       
        'Copy data from rekam a sheet
        Application.ScreenUpdating = False
       
        Sheets("form").Select
        Range("A1").FormulaR1C1 = "=INPUT!R[2]C[1]"
        Range("a:a").Select
        Selection.Copy
    
    With Sheets("INPUT")
        strdata1 = .Range("B1").Value 'jenis kayu
        strdata2 = .Range("B3").Value 'batch no
    End With
    
    If Application.WorksheetFunction.CountIfs(Worksheets("database").Range("2:2"), strdata1, Worksheets("database").Range("1:1"), strdata2) > 0 Then
    'if Data was found------------------------------------------------------------------------------------------------------
    Worksheets("database").Select
    Worksheets("database").Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
    Do Until ActiveCell.Offset(-1, 0).Value = strdata2
    Worksheets("database").Range("2:2").FindNext(After:=ActiveCell).Activate
    Loop
    
    
           ActiveCell.Offset(-1, 0).Select
                 
           'Past data changes
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("input").Select
        MsgBox "Row Updated"
    
    Else
    'if Data was not found------------------------------------------------------------------------------------------------------
     'Copy Macro
      Sheets("Input").Select
      Range("B3").Select
    ActiveCell.FormulaR1C1 = "=MAX(COUNTIF(database!r2c1:r2c500,input!r1c2)+1)"
     Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
       Sheets("form").Select
        Range("a1").FormulaR1C1 = "=MAX(COUNTIF(database!r2c1:r2c500,input!r1c2)+1)"
        
        
        Range("a:a").Offset(0, 0).Select
        Selection.Copy
     
    
        Sheets("database").Select
        Worksheets("DATABASE").Cells(Rows.Count, "A").End(xlUp).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=False
        'ActiveSheet.Paste
        ActiveCell.Offset(1).EntireColumn.Insert
        
        Sheets("input").Select
        MsgBox "Penyalinan berhasil!", vbInformation, "Informasi"
    
    End If
    
    Application.ScreenUpdating = True
    
    End Sub

    file terlampir ya

    saya hanya agak bingung dengan batch numbernya.. semoga tdk salah asumsi yah

    untuk rekan lain,silahkan menambahkan/ada solusi lain...

  11. Di sunting 10 bulan yang lalu oleh Fujiansyah92

    Secara teknis,script terbaru itu akan melakukan pencarian dg 2 kriteria yaitu nama kayu dan batch yg sama .(Sedangkan script lama, hanya akan mencari berdasarkan kriteria tunggal). Jika ditemukan,maka akan update data sesuai sheet input ke database,namun jika tdk ditemukan [walau salah satu dari 2 kriteria ditemukan] , akan membuat data baru(insert new column) .
    Untuk pembuatan No.batch,saya menggunakan script lama. [If found]: saya menggunakan No. batch sesuai inputan{sheet input} .[If not found] : saya menggunakan countif dg kriteria batch.

    Saya agak ragu untuk case pembuatan No.batch.mungkin harusnya sama antara [found] & [not found] kategori .

  12. terima kasih @Fujiansyah92 dengan memasukan rumus auto batch tanpa harus menjalankan new batch otomatis langsung menampilkan batchnya. terima kasih.

    tanya lagi bagaimana jika data yang di simpan tidak masuk ke dalam data base namun langsung ke masing2 sheet sesuai dengan jenis kayunya dan jika akan editpun akan mencari di sheet kayu tersebut.

    terima kasih.

  13. File terlampir ya..

    semoga membantu

  14. @Fujiansyah92 terima kasih, atas sharenya.
    apakah script dibawah ini bisa di gunakan untuk memanggil data (vlookup/lookup)

    Dim wsSheet As Worksheet
    Dim rngX As Range
    Dim strdata1, strdata2, mysht

    On Error Resume Next
    'Find with multiple criteria

    With Sheets("INPUT")
    mysht = .Range("B1").Value 'jenis kayu
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no
    End With

    If Application.WorksheetFunction.CountIfs(Worksheets(mysht).Range("2:2"), strdata1, Worksheets(mysht).Range("1:1"), strdata2) > 0 Then
    'if Data was found------------------------------------------------------------------------------------------------------

    Set wsSheet = Sheets(mysht)
    If Not wsSheet Is Nothing Then
    Sheets(mysht).Select
    Else
    Worksheets.Add
    ActiveSheet.Name = mysht
    End If

    Worksheets(mysht).Select
    Worksheets(mysht).Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
    Do Until ActiveCell.Offset(-1, 0).Value = strdata2
    Worksheets(mysht).Range("2:2").FindNext(After:=ActiveCell).Activate
    Loop

  15. Coba dirincikan maksudnya mau seperti apa?

  16. ketika saya ingin menampilkan jenis kayu k64 batch 5, maka akan di cari di sheet k64 selanjutnya menuju bacth 5 dan di tampilkan di sheet input sesuai dengan baris dan kolom yang ada di cel input.

  17. apakah script saat memasukan data tiap sheet itu dapat di gunakan dan di lanjutkan dengan lookup dan paste di sheet input?

  18. @Caton dan @Fujiansyah92

    mau tanya dengan kode
    Dim wsSheet As Worksheet
    Dim rngX As Range
    Dim strdata1, strdata2, mysht

    terutama yang mysht strdata1 dan strdata2 mohon penjelasannya.

    karena jika ingin rubah cellnya tetap tdk mau pindah. contoh

    With Sheets("INPUT")
    mysht = .Range("B1").Value 'jenis kayu
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no

    mysht = .Range("B1").Value 'jenis kayu ==> B1 saya rubah ke B4, setelah di jalankan hasilnya tetap di B1

  19. Di sunting 10 bulan yang lalu oleh Fujiansyah92

    @absetiawan18 @Caton dan @Fujiansyah92

    mau tanya dengan kode
    Dim wsSheet As Worksheet
    Dim rngX As Range
    Dim strdata1, strdata2, mysht

    terutama yang mysht strdata1 dan strdata2 mohon penjelasannya.

    karena jika ingin rubah cellnya tetap tdk mau pindah. contoh

    With Sheets("INPUT")
    mysht = .Range("B1").Value 'jenis kayu
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no

    mysht = .Range("B1").Value 'jenis kayu ==> B1 saya rubah ke B4, setelah di jalankan hasilnya tetap di B1

    coba upload file nya juga yg sudah dirubah. Secara penjelasan..kemungkinannya seperti ini
    (1) Itu kan hanya sebagai trigger nama sheet.Jika range tsb (misal range B4) blank...maka akan tdk jalan (karena nama sheet,tdk bisa blank
    (2) Logika di script tsb itu adalah...

    • mysht sbg trigger nama sheet & data input
    • strdata1 sbg trigger pertama untuk membaca/menentukan letak kolom target
    • strdata2 sbg trigger kedua untuk membaca/menentukan letak kolom target
  20. @absetiawan18 Dim wsSheet As Worksheet
    Dim rngX As Range
    Dim strdata1, strdata2, mysht

    On Error Resume Next
    'Find with multiple criteria

    With Sheets("INPUT")
    mysht = .Range("B1").Value 'jenis kayu
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no
    End With

    If Application.WorksheetFunction.CountIfs(Worksheets(mysht).Range("2:2"), strdata1, Worksheets(mysht).Range("1:1"), strdata2) > 0 Then
    'if Data was found------------------------------------------------------------------------------------------------------

    Set wsSheet = Sheets(mysht)
    If Not wsSheet Is Nothing Then
    Sheets(mysht).Select
    Else
    Worksheets.Add
    ActiveSheet.Name = mysht
    End If

    Worksheets(mysht).Select
    Worksheets(mysht).Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
    Do Until ActiveCell.Offset(-1, 0).Value = strdata2
    Worksheets(mysht).Range("2:2").FindNext(After:=ActiveCell).Activate
    Loop

    untuk case ini,

    coba pakai ini :

    Sub Find_Data()
    Dim wsSheet As Worksheet
    Dim rngX As Range
    Dim strdata1, strdata2, mysht
    
    On Error Resume Next
    'Find with multiple criteria
    
    With Sheets("INPUT")
    mysht = .Range("B1").Value 'jenis kayu
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no
    End With
    
    If Application.WorksheetFunction.CountIfs(Worksheets(mysht).Range("2:2"), strdata1, Worksheets(mysht).Range("1:1"), strdata2) > 0 Then
    'if Data was found------------------------------------------------------------------------------------------------------
    MsgBox "Data was found !!", vbInformation, "Found"
    Worksheets(mysht).Select
    Worksheets(mysht).Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
    Do Until ActiveCell.Offset(-1, 0).Value = strdata2
    Worksheets(mysht).Range("2:2").FindNext(After:=ActiveCell).Activate
    Loop
    Else
    MsgBox "Data was not found !!", vbCritical, "Not Found"
    End If
    End Sub

  21. Newer ›
 

atau Mendaftar untuk ikut berdiskusi!