Dear All,
setelah di coba macronya sudah jalan tapi masih mencari solusi agar tidak usah mengedit macro untuk merubah nama file "rev.xls" dan nama sheet di "rev.xls"
karena data yang diterima dari customer selalu berubah baik nama file dan nama sheets juga range area
apakah bisa dirubah nama file dan sheet menjadi variable
berikut cuplikannya
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 carinilai = ketemu
End Function
Sub ya()
Dim filerev As String
Dim sel, ketemu As Range
kolomrev = 11
kolomubah = 33
rgrev = "g5:g130"
rgubah = "a5:ag1800"
Dim wk, wkrev As Workbook
filerev = ActiveWorkbook.Path & "\Rev.xls"
Set wk = ActiveWorkbook
Set wkrev = Workbooks.Open(Filename:=filerev)
For Each sel In wkrev.Sheets("Revised").Range(rgrev)
nilaicari = sel.Offset(0, 0)
nilaiganti = sel.Offset(0, kolomrev)
Set ketemu = carinilai(wk.Sheets("list").Range(rgubah), nilaicari)
If Not ketemu Is Nothing Then
ketemu.Offset(0, kolomubah) = nilaiganti
With ketemu.Offset(0, kolomubah).Interior
.ColorIndex = 6
End With
End If
Next
End Sub
regards,
Gultom
--- 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] Re: merevisi isi data
To: belajar-excel@yahoogroups.com
Date: Monday, July 4, 2011, 4:29 PM
kalau berkenan tolong dikoreksi karena waktu saya exekusi fail
data terlampir
--- On Mon, 7/4/11, sudarsono <jkssbma@live.com> wrote:
From: sudarsono <jkssbma@live.com>
Subject: [belajar-excel] Re: merevisi isi data
To: belajar-excel@yahoogroups.com
Date: Monday, July 4, 2011, 4:16 PM
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
koreksi menjadi
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 carinilai= ketemu
End Function
menurut saya apa yang disarankan Master Kid itu benar, gunakan fungsi cariniai untuk memperoleh baris yang diinginkan.....
--- In belajar-excel@yahoogroups.com, R T Gultom <ro_tag@...> wrote:
>
> betul juga sih, tapi masih belum ketemu formatnya mengingat
> Ada data type barang dengan kondisi order no (IP), tanggal order, tanggal permintaan (bulan), jumlah per bulan (di insert baris) menkondisikan pengiriman barang karena tanggal permintaan bisa 5 kali dalam satu minggu sementara tangal pengiriman cuma satu kali dalam seminggu
> dengan kondisi tertentu si customer bisa merubah tanggal permintaan sesuai dengan lain productnya mereka dan ini yang akan saya robah (dal;am case ini) untuk menyesuaikan kembali tanggal pengiriman
>
> Â setelah itu saya pivot untuk mengetaui per type per minggu dan per bulan berapa
>
>
> --- On Mon, 7/4/11, Mr. Kid <mr.nmkid@...> wrote:
>
> From: Mr. Kid <mr.nmkid@...>
> Subject: Re: [belajar-excel] merevisi isi data
> To: belajar-excel@yahoogroups.com
> Date: Monday, July 4, 2011, 3:13 PM
>
>
>
>
>
>
>
> Â
>
>
>
>
>
>
>
>
>
> Kenapa tidak buat master data yang berisi :
> tgl_input , tgl_ip , nilai_ip
> Kan gak repot mewarnai, gak repot cari-cari, bisa report banyak hal, sampai sejarah penggantiannya pun bisa.
>
> ;-)
> Kid.
>
>
>
> 2011/7/4 R T Gultom <ro_tag@...>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> Â
>
>
>
>
>
>
>
>
>
> mulai mendekati. tapi saya pelajari dulu untuk merubah variablenya
> tapi kalau tidak salah sepintas bahwa di revisi kita sorot satu persatu sehingga macro exekusi dengan mengganti tangal di list cmiiw
>
>
> ntar kalau mentok nanya lagi yah.....
> sebenarnya masih ada tambahan yaitu setelah diganti tanggal dengan tanggal revisi di beri warna di range untuk menandakan itu adalah revisi,
>
>
>
> --- On Mon, 7/4/11, Sudarsono Suhenk <jkssbma@...> wrote:
>
>
>
> From: Sudarsono Suhenk <jkssbma@...>
> Subject: RE: [belajar-excel] merevisi isi data
>
>
> To: "belajar excel yahoo.com" <belajar-excel@yahoogroups.com>
> Date: Monday, July 4, 2011, 2:53 PM
>
>
>
>
>
>
>
>
>
> Â
>
>
>
>
>
>
>
>
>
> 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@...
> 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 list 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@...> wrote:
>
> From: R T Gultom <ro_tag@...>
>
>
> 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@...> wrote:
>
> From: Sudarsono Suhenk <jkssbma@...>
>
>
> 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@...
>
>
> 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")