Hai Jan, "kenapa kalo Jan set nilai *quantity *menjadi 100 K scriptnya tidak bisa jalan ya?" >> variabel quantity-nya yang iQty ya ? >> tipe datanya integer kan ya (prefix i biasanya untuk integer). >> Coba diganti dengan tipedata Long, karena Integer dari -32K sekian sampai +32K sekian
Wassalamu'alaikum Wr. Wb. Kid. On Wed, Apr 3, 2013 at 5:20 PM, Jan Raisin <[email protected]>wrote: > ** > > > coba script berikut: > > ========================================================================= > ditulis dalam sheet rencana dengan event Change > > Private Sub Worksheet_Change(ByVal Target As Range) > With Target > If .Cells.Count = 1 Then > If .Row = 11 And .Column = 2 Then > .Offset(, -1).Value = 1 > ElseIf .Row > 11 And .Column = 2 Then > .Offset(, -1).Value = .Offset(-1, -1).Value + 1 > End If > End If > End With > End Sub > > ========================================================================= > > > ========================================================================= > ditulis di command button 1 > > Private Sub cmd1_Click() > Dim TempArray() As Variant > Dim iQty As Integer, i As Integer, j As Integer, iCol As Integer > Dim lRowPlan As Long, lRowAct As Long, lNbr As Long, lCount As Long, > Nbr As Long > Dim rngAct As Range, rngNbr As Range, rNbr As Range > Dim sStart As Single > > Application.ScreenUpdating = False > sStart = Timer > lRowPlan = Selection.Row > If lRowPlan <= 10 Then Exit Sub > iQty = Cells(lRowPlan, 5).Value > With Sheets("realisasi") > lRowAct = .Cells(Rows.Count, 1).End(xlUp).Row > Set rngAct = .Range(.Cells(lRowAct + 1, 2), .Cells(lRowAct + iQty, > 6)) > End With > ReDim TempArray(1 To iQty, 1 To 5) > For i = 1 To iQty > iCol = 2 > For j = 1 To 5 > TempArray(i, j) = Cells(lRowPlan, iCol).Value > iCol = iCol + 1 > Next j > Next i > rngAct.Value = TempArray > With Sheets("realisasi") > lRowAct = .Cells(Rows.Count, 2).End(xlUp).Row > If lRowAct = 11 Then > Cells(11, 1).Value = 1 > ElseIf lRowAct > 11 Then > lNbr = .Cells(Rows.Count, 1).End(xlUp).Row > Set rngNbr = .Range(.Cells(11, 1), .Cells(lRowAct, 1)) > Nbr = 1 > For Each rNbr In rngNbr > rNbr = Nbr > Nbr = Nbr + 1 > Next rNbr > End If > End With > Application.ScreenUpdating = True > MsgBox "Berhasil mengcopy " & Format(iQty, "#,###") & " data dalam > waktu " & Format(Timer - sStart, "0,000") & " detik", _ > vbOKOnly, "Done" > End Sub > > > ====================================================================================================================== > > > > ====================================================================================================================== > > ditulis di command button 2 > > Private Sub cmd2_Click() > Dim lRow As Long, Nbr As Long > Dim rngNbr As Range, rNbr As Range > > With Sheets("finishing") > lRow = .Cells(Rows.Count, 1).End(xlUp).Row > Range(Range("a11"), Range("a11").End(xlToRight).End(xlDown)).Copy > .Cells(lRow + 1, 1).PasteSpecial (xlPasteAll) > lRow = .Cells(Rows.Count, 1).End(xlUp).Row > Set rngNbr = .Range(.Cells(11, 1), .Cells(lRow, 1)) > Nbr = 1 > For Each rNbr In rngNbr > rNbr.Value = Nbr > Nbr = Nbr + 1 > Next rNbr > End With > End Sub > > > =================================================================================================================== > > sekalian Jan mau tanya ke rekan-rekan yang lain.. kenapa kalo Jan set > nilai quantity menjadi 100 K scriptnya tidak bisa jalan ya? > > file terlampir > > Wassalam, > > > -Miss Jan Raisin- > > > Pada 3 April 2013 10.41, sapicumi <[email protected]> menulis: > > ** >> >> >> Selamat siang para Mastah di milis ini >> begini mastah2 saya ada sedikit kesulitan mengenai looping yg berdasarkan >> angka atau jumlah yg berada di kolom tertentu.... untuk lebih jelasnya >> saya >> lampirkan file saya trimakasih atas bantuan dan jalan keluar yg diberikan >> >> Looping.xlsm >> < >> http://milis-belajar-excel.1048464.n5.nabble.com/file/n5717047/Looping.xlsm> >> >> >> -- >> View this message in context: >> http://milis-belajar-excel.1048464.n5.nabble.com/Looping-berdasarkan-angka-di-kolom-tertentu-tp5717047.html >> Sent from the Milis Belajar Excel mailing list archive at Nabble.com. >> > >
