hmmm...
kalo ndak salah, kondisinya hanya ada 2, yaitu :
A. tanggal data = tanggal hari
ini
-> expired (kalau tanggal data < tanggal hari ini bagaimana ?)
B. tanggal data > tanggal hari ini DAN tanggal data < tanggal hari ini +
7 -> akan expired (kalau lebih dari tanggal hari ini + 6 gimana ?)
perlakuan berdasar kondisi ada 2, yaitu :
1. isi listbox
kalau kondisi A : isi listbox1
kalau kondisi B : isi listbox2
2. set warna cells
kalau kondisi A : warna index 6
kalau kondisi B : warna index 7
Andai sudah ditulis lengkap seperti di atas, tentu akan lebih mudah
menyusun alur prosesnya dari awal, contoh proses :
1. isi listbox dengan header (header di letakkan di item ke-1 listbox [item
ke-1 listbx ber-index-0])
> mungkin pembuatnya ingin membuat 1 variabel penyimpan teks header
supaya kelak kalau mengganti hanya mengganti 1 variabel saja
dim y as *string* 'tidak perlu Variant, supaya hemat dan cepat
(menurut konsep datatype)
y="Date Supplier -> No. Document"
ListBox1.AddItem y
ListBox2.AddItem y
'kalau tidak ingin pakai dim, baris additem bunyinya :
'ListBox1.AddItem "Date Supplier -> No. Document"
'ListBox2.AddItem "Date Supplier -> No. Document"
2. menentukan area range tanggal data
dim rDates As Range
with sheet3
Set rDates = .Range(.Cells(11, 7), .Cells(.Rows.Count,
7).End(xlUp))
End With
3. set warna cells di area range tanggal data, mulai dari kolom ke-4
sebelum kolom tanggal data sampai kolom tanggal data (5 kolom)
rdates.offset(0,-4).resize(,5).interior.colorindex=0
4. menyimpan nilai tanggal hari ini ke dalam sebuah variabel, karena akan
dibandingkan berulang-ulang
dim dtHariIni as date
dthariini=date
5. memeriksa setiap tanggal data (dalam range tanggal data) dan
memperlakukan setiap cells baris tersebut mulai 4 kolom sebelum kolom
tanggal data sebanyak 5 kolom
dim cl as range
for each cl in rdates
with cl 'karena cl akan dipakai secara aktif
if .value>dthariini then 'kondisi B bagian >
if .value<dthariini+7 then 'kondisi B bagian <
'kondisi B terpenuhi secara utuh disini
ListBox2.AddItem Format(.Offset(0, 0).Value,
"dd-mmm-yy") & " " & Format(.Offset(0, -3).Value, "") & " -> " &
.Offset(0, -1) 'perlakuan 1 : isi listbox2
.Offset(0, -4).Resize(, 5).Interior.ColorIndex =
7 'perlakuan 2 : set warna cells dengan 7
endif
elseif .value=dthariini then 'kondisi A
'kondisi A terpenuhi secara utuh disini
ListBox1.AddItem Format(.Offset(0, 0).Value,
"dd-mmm-yy") & " " & Format(.Offset(0, -3).Value, "") & " -> " &
.Offset(0, -1) 'perlakuan 1 : isi listbox1
.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
'perlakuan 2 : set warna cells dengan 6
endif
end with
next cl
Kalau semuanya dikumpulkan jadi satu :
'deklarasi variabel
dim y as *string* 'tidak perlu Variant, supaya hemat dan cepat
(menurut konsep datatype)
dim rDates As Range
dim dtHariIni as date
dim cl as range
'init area kerja
'1 : header listboxes
y="Date Supplier -> No. Document"
ListBox1.AddItem y
ListBox2.AddItem y
'2. range tanggal data
with sheet3
Set rDates = .Range(.Cells(11, 7), .Cells(.Rows.Count,
7).End(xlUp))
End With
'3. warna cells di 5 kolom berurutan sampai kolom tanggal data
rdates.offset(0,-4).resize(,5).interior.colorindex=0
'4. nilai tanggal hari ini
dthariini=date
'proses utama
for each cl in rdates
with cl 'karena cl akan dipakai secara aktif
if .value>dthariini then 'kondisi B bagian >
if .value<dthariini+7 then 'kondisi B bagian <
'kondisi B terpenuhi secara utuh disini
ListBox2.AddItem Format(.Offset(0, 0).Value,
"dd-mmm-yy") & " " & Format(.Offset(0, -3).Value, "") & " -> " &
.Offset(0, -1) 'perlakuan 1 : isi listbox2
.Offset(0, -4).Resize(, 5).Interior.ColorIndex =
7 'perlakuan 2 : set warna cells dengan 7
endif
elseif .value=dthariini then 'kondisi A
'kondisi A terpenuhi secara utuh disini
ListBox1.AddItem Format(.Offset(0, 0).Value,
"dd-mmm-yy") & " " & Format(.Offset(0, -3).Value, "") & " -> " &
.Offset(0, -1) 'perlakuan 1 : isi listbox1
.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
'perlakuan 2 : set warna cells dengan 6
endif
end with
next cl
Regards,
Kid
On Sat, Sep 24, 2016 at 10:58 AM, Nang Agus [email protected]
[belajar-excel] <[email protected]> wrote:
>
>
> Coba begini:
> Dim rDates As Range
> Dim x As Variant
> Dim y As Variant
> Dim z As Variant
> *Dim o As Integer*
> With Sheet3
> Set rDates = .Range(.Cells(11, 7), .Cells(.Rows.Count, 7).End(xlUp))
> End With
> y = "Date Supplier -> No. Document"
> ListBox1.AddItem y
> ListBox2.AddItem y
> Cells.Select
> With Selection.Interior
> .Pattern = xlNone
> .TintAndShade = 0
> .PatternTintAndShade = 0
> End With
> Range("A1").Select
>
> 'Dokumen Sudah Expired
> For Each cl In rDates
> Select Case cl.Value
> Case Is = Date
> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
> ListBox1.AddItem x
> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 7
> End Select
> Next cl
>
> 'Dokumen Akan Expired +7
> *For o = 1 To 6*
> For Each cl In rDates
> Select Case cl.Value
> Case Is = Date + o
> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
> ListBox2.AddItem x
> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
> End Select
> Next cl
> *Next o*
> End Sub
>
>
> On Fri, Sep 23, 2016 at 1:49 PM, 'Heri Pamungkas ( Gmail )'
> [email protected] [belajar-excel] <[email protected]>
> wrote:
>
>>
>>
>> Assalamualaikum.
>>
>> Dear Teman-Teman Be-Exceller,
>>
>> Saya ada kendala di panjangnya script berikut,
>> nah rencana saya mau looping untuk bagian berwarna biru.
>>
>> Mohon bantuan idenya.
>>
>> Berikut Scriptnya :
>>
>> 'credit to Slamet <[email protected]> <[email protected]> @
>> [email protected]
>> 'Adjustment Heri Pamungkas
>>
>> Private Sub UserForm_Initialize()
>> Dim rDates As Range
>> Dim x As Variant
>> Dim y As Variant
>> Dim z As Variant
>>
>> With Sheet3
>> Set rDates = .Range(.Cells(11, 7), .Cells(.Rows.Count, 7).End(xlUp))
>> End With
>> y = "Date Supplier -> No. Document"
>> ListBox1.AddItem y
>> ListBox2.AddItem y
>> Cells.Select
>> With Selection.Interior
>> .Pattern = xlNone
>> .TintAndShade = 0
>> .PatternTintAndShade = 0
>> End With
>> Range("A1").Select
>>
>> 'Dokumen Sudah Expired
>> For Each cl In rDates
>> Select Case cl.Value
>> Case Is = Date
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox1.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 7
>> End Select
>> Next cl
>>
>> 'Dokumen Akan Expired +7
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 1*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 2*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 3*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 4*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 5*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> For Each cl In rDates
>> Select Case cl.Value
>> *Case Is = Date + 6*
>> x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " &
>> Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
>> ListBox2.AddItem x
>> cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
>> End Select
>> Next cl
>> End Sub
>>
>>
>> وَالسَّلَامُ عَلَيْكُمْ وَرَحْمَةُ اللهِ وَبَرَكَاتُهُ
>>
>> Warm Regards,
>>
>>
>
>