Bulan
IP
1-Jun-2011
IP-3457
2-Jun-2011
IP-3458
3-Jun-2011
IP-3459
4-Jun-2011
IP-3460
5-Jun-2011
IP-3461
6-Jun-2011
IP-3462
7-Jun-2011
IP-3463
8-Jun-2011
IP-3464
9-Jun-2011
IP-3465
10-Jun-2011
IP-3466
11-Jun-2011
IP-3467
12-Jun-2011
IP-3468
13-Jun-2011
IP-3469
14-Jun-2011
IP-3470
15-Jun-2011
IP-3471
16-Jun-2011
IP-3472
17-Jun-2011
IP-3473
18-Jun-2011
IP-3474
19-Jun-2011
IP-3475
20-Jun-2011
IP-3476
21-Jun-2011
IP-3477
22-Jun-2011
IP-3478
Bulan
IP
13-Jun-2011
IP-3465
16-Jun-2011
IP-3466
4-Jun-2011
IP-3467
21-Jun-2011
IP-3468
Bulan
IP
1-Jun-2011
IP-3457
2-Jun-2011
IP-3458
3-Jun-2011
IP-3459
4-Jun-2011
IP-3460
5-Jun-2011
IP-3461
6-Jun-2011
IP-3462
7-Jun-2011
IP-3463
8-Jun-2011
IP-3464
13-Jun-2011
IP-3465
16-Jun-2011
IP-3466
11-Jun-2011
IP-3467
21-Jun-2011
IP-3468
13-Jun-2011
IP-3469
14-Jun-2011
IP-3470
15-Jun-2011
IP-3471
16-Jun-2011
IP-3472
17-Jun-2011
IP-3473
18-Jun-2011
IP-3474
19-Jun-2011
IP-3475
20-Jun-2011
IP-3476
21-Jun-2011
IP-3477
22-Jun-2011
IP-3478
untuk IP-3467 apa tanggal terakhir 11 Juni 2011 , bukan 4 Juni 2011 ? Sub
GabungTabelAntarWorkbook()
' siti Vi // Bluewater, 1 Juli 2011
' workbook "rev.xls" harus sudah terbuka
'---------------------------------------
Dim INDUK As Range, ANAKK As Range
Set INDUK = ctvUsedRange(ThisWorkbook.Sheets("Sumeri"))
Set ANAKK = ctvUsedRange(Workbooks("rev.xls").Sheets("ubah")).Offset(1, 0)
Dim jumbaris As Long
jumbaris = INDUK.Rows.Count
INDUK.Copy Destination:=Sheets("sheet1").Range("A1")
ANAKK.Copy Destination:=Sheets("sheet1").Range("A" & jumbaris + 1)
Call sortdata
End Sub
'===================================================================================================
Private Function ctvUsedRange(Optional Sht As Worksheet) As Range
' siti Vi // Bluewater, 24 Nov 2009
' last refine: Jurangmangu, 19 Jun 2011
'---------------------------------------
Dim FstRow As Long, FstCol As Integer
Dim LstRow As Long, LstCol As Integer
On Error Resume Next
If Sht Is Nothing Then Set Sht = ActiveSheet ' Else Set Sht = Sht
With Sht
Sht.Select
If Not Cells(1) = vbNullString Then
FstRow = 1: FstCol = 1
Else
FstRow = .Cells.Find(What:="*", SearchDirection:=xlNext,
SearchOrder:=xlByRows).Row
FstCol = .Cells.Find(What:="*", SearchDirection:=xlNext,
SearchOrder:=xlByColumns).Column
End If
LstRow = .Cells.Find(What:="*", SearchDirection:=xlPrevious,
SearchOrder:=xlByRows).Row
LstCol = .Cells.Find(What:="*", SearchDirection:=xlPrevious,
SearchOrder:=xlByColumns).Column
Set ctvUsedRange = Range(.Cells(FstRow, FstCol), .Cells(LstRow, LstCol))
End With
End Function
'====================================================================================================
Sub sortdata()
Sheets("Sheet1").Select
Range("A1").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("B2:B27") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("A2:A27") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:B27")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$B$27").RemoveDuplicates Columns:=Array(1, 2),
Header _
:=xlYes
ActiveSheet.Range("$A$1:$B$27").RemoveDuplicates Columns:=2,
Header:=xlYesEnd Sub
catatan :Bu Devi , saya ambil beberapa koding nya dan saya modif . Trim's.
To: [email protected]
From: [email protected]
Date: Fri, 1 Jul 2011 15:05:52 +0700
Subject: Re: [belajar-excel] merevisi isi data
gak ada kabarnya ?... ya udah, kita anggap seperti DUGAAN semula, dengan
tambahan asumsi sbb:
** tabel yg ada di "workbook List / sheet Sumeri" adalah satu satunya range yg
ada di sheet itu
di cell lain tidak ada satu titik data pun (kalau ada, deteksi letak tabel bisa
salah)
t** abel yg ada di "workbook rev / sheet ubah" adalah satu satunya range yg
ada di sheet itu
di cell lain tidak ada satu titik data pun (kalau ada, deteksi letak tabel bisa
salah)
** saat makro mulai dijalankan(makro berada di workbook LIST), workbook REV
harus susah dibuka.
Kedua tabel yg akan digabung itu boleh dipindah pindah letaknya (termasuk
diperbanyak datanya / penambahan ke bawah ) asal masih didalam sheet yg sama;
tetapi tidak boleh
ada data/tabel lain diluar range tabel tsb
Sub GabungTabelAntarWorkbook()
' siti Vi // Bluewater, 1 Juli 2011
' workbook "rev.xls" harus sudah terbuka
'---------------------------------------
Dim INDUK As Range, ANAKK As Range
Set INDUK = ctvUsedRange(ThisWorkbook.Sheets("Sumeri")) Set ANAKK =
ctvUsedRange(Workbooks("rev.xls").Sheets("ubah")).Offset(1, 0)
ANAKK.Copy INDUK(INDUK.Rows.Count + 1, 1)
INDUK.CurrentRegion.Sort _ Key1:=INDUK(1, 2), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
2011/7/1 STDEV(i) <[email protected]>
jadi maksud yg sebenarnya bagaimana, mohon diceritakan
(kalau melihat GAMBARAN HASIL yg diperlihatkan tadi, sepertinya "jalan
ceritak"
yg siti ajukan tadi sudah sesuaijika belum sesuai, di bagian mananya yg masih
perlu ubah ?
nanti bisa kita perbaiki.
setelah oke, soal mengimplementasikan ke code itu masalah kedua dan gampang.
mengenai jumlah records (volume data) tidak jadi masalah, prinsip kerjanya
tetap sama.
sample yg diajukan seharusnya menggambarkan / mewakili keadaan faktualnya
2011/7/1 R T Gultom <[email protected]>
Sebenarnya selama ini saya pakai system manual
dengan vlookup di dummy column di file "List" terus saya pindahin dan di beri
color
data revisi tidak berurutan sebenarnya hanay sample saya ambil dari data (list)
Siti Vi wrote
Pakai cara praktis saja
1. deteksi letak cell kosong di bawah tabel 1 (list), cukup 1 cell di kolom 1
saja
2. deteksi letak & dimensi tabel 2 (rev) lalu dicopy3. dipaste ke cell hasil
langkah 1
4. range baru yg terbentk dikenakan metoda sort dengan kolom 2 sbg kunci
sorting, order: manaik
