gunakan saja find : Function carinilai(ByVal daerah As Range, ByVal strcari As String) As Range
Dim ketemu As Range
Set ketemu = daerah.Find(
what:=strcari, LookIn:=xlValues, SearchOrder:=xlByRows)
Set cariterakhir = ketemu
End Function Sub ya()
Dim sel As Range
Dim wk As Workbook
Set wk = ActiveWorkbook
For Each sel In Workbooks("rev.xls").Sheets("ubah").Range("Q31:Q34")
nilaicari = sel.Offset(0, 0)
nilaiganti = sel.Offset(0, -1)
Set ketemu = carinilai(wk.Sheets("Sumeri").Range("N8:O29"), nilaicari)
If Not ketemu Is Nothing Then
ketemu.Offset(0, -1) = nilaiganti
End If
Next
End Sub
'===============To: belajar-excel@yahoogroups.com
From: ro_tag@yahoo.com
Date: Mon, 4 Jul 2011 15:05:43 +0800
Subject: RE: [belajar-excel] merevisi isi data
sebenarnya yang dibutuhkan adalah sebagai berikut :
cari ip revisi di ip lista dan
ganti tanggal list dengan tanggal revisi
tapi membuat loopnya ribet saya utak-utik tidak ketemu
--- On Mon, 7/4/11, R T Gultom <ro_tag@yahoo.com> wrote:
From: R T Gultom <ro_tag@yahoo.com>
Subject: RE: [belajar-excel] merevisi isi data
To: belajar-excel@yahoogroups.com
Date: Monday, July 4, 2011, 2:01 PM
Wah mantab, tapi sayang persayaratannya adalah :
tidak ada penghapusan baris, karena isi dari baris revisi dengan list tidak sama, sehingga masih ada yang dipakai di list data baris sebelumnya
sebenarnya yang dibuthkan adalah bagaimana mengganti tangal yang di revisi saja tanpa menambah baris atau menghapus baris
karena masing2 data isinya selain dari IP dan tanggal adalah berbeda-beda
Regards,
Gultom
--- On Fri, 7/1/11, Sudarsono Suhenk <jkssbma@live.com> wrote:
From: Sudarsono Suhenk <jkssbma@live.com>
Subject: RE: [belajar-excel] merevisi isi data
To: "belajar excel yahoo.com" <belajar-excel@yahoogroups.com>
Date: Friday, July 1, 2011, 7:40 PM
atau jika apapun yang ada di sheet ubah yang merupakan kondisi terakhir ( update ) gunakan cara ini :
Option Explicit
Sub GabungTabelAntarWorkbook()
Dim AnakDulu As Boolean
AnakDulu = True
Dim INDUK As Range, ANAKK As Range
Dim workbookutama, workbookanak As String
workbookutama = ActiveWorkbook.Name
Workbooks.Open Filename:=ActiveWorkbook.Path & "\rev.xls", Notify:=False
workbookanak = ActiveWorkbook.Name
Dim jumbaris As Long
If AnakDulu Then
Workbooks(workbookanak).Activate
Set ANAKK = ctvUsedRange(Workbooks("rev.xls").Sheets("ubah"))
Set INDUK = ctvUsedRange(ThisWorkbook.Sheets("Sumeri")).Offset(1,
0)
jumbaris = ANAKK.Rows.Count
Else
Workbooks(workbookutama).Activate
Set INDUK = ctvUsedRange(ThisWorkbook.Sheets("Sumeri"))
Set ANAKK = ctvUsedRange(Workbooks("rev.xls").Sheets("ubah")).Offset(1, 0)
jumbaris = INDUK.Rows.Count
End If
Workbooks(workbookutama).Activate
If AnakDulu Then
ANAKK.Copy Destination:=Sheets("sheet1").Range("A1")
INDUK.Copy Destination:=Sheets("sheet1").Range("A" & jumbaris + 1)
Else
INDUK.Copy
Destination:=Sheets("sheet1").Range("A1")
ANAKK.Copy Destination:=Sheets("sheet1").Range("A" & jumbaris + 1)
End If
Call hapusganda
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
End Sub
Sub hapusganda()
Sheets("Sheet1").Select
Range("A1").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveSheet.Range("$A$1:$B$27").RemoveDuplicates Columns:=Array(1, 2), Header _
:=xlYes
ActiveSheet.Range("$A$1:$B$27").RemoveDuplicates Columns:=2, Header:=xlYes
End Sub
Apa sudah sesuai ???
To: belajar-excel@yahoogroups.com
From: jkssbma@live.com
Date: Fri, 1 Jul 2011 17:09:37 +0700
Subject: RE: [belajar-excel] merevisi isi data
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:=xlYes
End Sub
catatan :
Bu Devi , saya ambil beberapa koding nya dan saya modif . Trim's.
To: belajar-excel@yahoogroups.com
From: setiyowati.devi@gmail.com
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)