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,
>>
>>
> 
>

Kirim email ke