Eureka...baru ketemu macronya. Sila lihat file terlampir. Coba bandingkan LOUV mainan mbak Siti dengan Unik_Lup (editannya)--> Font dibold hitam dan hijau
Function LOUV(D As Range)
'---------------------------------------------------------------------
' membuat daftar unique value berdasarkan range data
' coded by siti Vi / feb2006, di bluewater /recoded: 1jul2007, di jkt
'---------------------------------------------------------------------
Dim A(), X(), v, n As Integer, p As Integer, q As Integer, r As Integer
ReDim A(1 To D.Cells.Count)
For n = 1 To UBound(A): A(n) = D.Cells(n): Next n
For n = 1 To UBound(A) - 1
For q = UBound(A) To n + 1 Step -1
p = q - 1
If A(p) > A(q) Then
v = A(p): A(p) = A(q): A(q) = v
Else
If A(p) = A(q) Then A(q) = ""
End If
Next q
Next n
For n = 1 To UBound(A)
If Not A(n) = "" Then
r = r + 1: ReDim Preserve X(1 To r): X(r) = A(n)
End If
Next n
LOUV = WorksheetFunction.Transpose(X)
End Function
Sub Unik_Lup()
'---------------------------------------------------------------------
' membuat daftar unique value berdasarkan range data
' coded by siti Vi / feb2006, di bluewater /recoded: 1jul2007, di jkt
' edited by HK at 4 Sept 2014
'---------------------------------------------------------------------
Dim D As Range
Dim A(), X(), v, n As Integer, p As Integer, q As Integer, r As Integer
Set D = Selection
ReDim A(1 To D.Cells.Count)
For n = 1 To UBound(A): A(n) = D.Cells(n): Next n
For n = 1 To UBound(A) - 1
For q = UBound(A) To n + 1 Step -1
p = q - 1
If A(p) > A(q) Then
v = A(p): A(p) = A(q): A(q) = v
Else
If A(p) = A(q) Then A(q) = ""
End If
Next q
Next n
For n = 1 To UBound(A)
If Not A(n) = "" Then
r = r + 1: ReDim Preserve X(1 To r): X(r) = A(n)
End If
Next n
Range("B2", Range("B2").End(xlDown)).ClearContents
Range("B2:B" & r + 1) = WorksheetFunction.Transpose(X)
End Sub
Salam,
HK
On Thursday, 4 September 2014, 14:34, "'Mr. Kid' [email protected]
[belajar-excel]" <[email protected]> wrote:
Ganti formula penggunaan LOUV jangan menjadi array block.
Cara :
1. hapus formula di kolom hasil (asumsi baris 1 header hasil dan record hasil
pertama di baris 2, kolomnya bebas)
2. klik cell baris ke-2 (1 cell saja)
3. tulis formula : (sesuaikan rujukan range datanya)
=IFError( Index( LOUV( range_datanya_minimal_absolute_reference_baris ),
row()-1 ) , "" )
*** jika regional setting komputer setempat adalah Indonesian, ganti karakter
koma dengan titik koma.
4. copy formula ke baris berikutnya di kolom hasil (sesukanya atau sekuatnya
komputer atau sesabarnya user menunggu kalkulasi)
Wassalam,
Kid.
2014-09-04 14:18 GMT+10:00 Hendrik Karnadi [email protected]
[belajar-excel] <[email protected]>:
>
>Saya cuma nerusin pak. Yang punya ga bisa dihubungi lagi..terpaksa minta
>bantuan Mr. Kid atau pakar lainnya.
>
>
>Salam,
>HK
>
>
>Sent from Samsung Mobile
>
>
>-------- Original message --------
>From: "ris ha [email protected] [belajar-excel]"
>Date:04/09/2014 09:45 (GMT+07:00)
>To: [email protected]
>Subject: Re: [belajar-excel] menghilangkan blank cell dan menurutkan data text
>[1 Attachment]
>
>
>Maaf file gambarnya ketinggalan
>
>
>Macro dari pak Hendrik Luar Biasa, hanya saja, tatkala tidak ada datanya
terjadi error, seperti pada gambar (maaf susah njelasinnya, jadi pake
gambar aja). Setelah pake IFERROR tetap tidak jadi, bagaimana ya jika
#N/A tidak tampil ato dihilangkan? Maaf mau utak atik macronya ga paham
Makasih
>
>
>
>
>
>
>On Thursday, September 4, 2014 9:34 AM, ris ha <[email protected]> wrote:
>
>
>
>Macro dari pak Hendrik Luar Biasa, hanya saja, tatkala tidak ada datanya
>terjadi error, seperti pada gambar (maaf susah njelasinnya, jadi pake gambar
>aja). Setelah pake IFERROR tetap tidak jadi, bagaimana ya jika #N/A tidak
>tampil ato dihilangkan? Maaf mau utak atik macronya ga paham Makasih
>
>
>
>
>On Wednesday, September 3, 2014 3:48 PM, "hendrik karnadi
>[email protected] [belajar-excel]" <[email protected]>
>wrote:
>
>
>
>
>Hasilnya seperti file terlampir.
>
>
>Salam,
>HK
>
>
>
>
>
>
>On Wednesday, 3 September 2014, 15:01, "Hendrik Karnadi
>[email protected] [belajar-excel]" <[email protected]>
>wrote:
>
>
>
>
>Kalau susunan datanya tidak urut ...terpaksa pakai UDF nya mbak Siti (LOUV
>kependekan dari List Of Unique Values).
>Masalahnya, jika baris yg disorot berlebih maka akan keluar #N/A.
>
>
>Salam,
>HK
>
>
>
>
>
>
>Sent from Samsung Mobile
>
>
>-------- Original message --------
>From: "'Bagus' [email protected] [belajar-excel]"
>Date:03/09/2014 14:54 (GMT+07:00)
>To: [email protected]
>Subject: Re: [belajar-excel] menghilangkan blank cell dan menurutkan data text
>
>
>
>Wa'alaykum salam warohmatullohi
wabarokatuhu..
>
>Coba begini pada B2, (Array formula
ya):
>=IFERROR(INDEX($A$2:$A$12,MATCH(SUM(COUNTIF($A$2:$A$12,B$1:B1)),COUNTIF($A$2:$A$12,"<"&$A$2:$A$12),0)),"")
>
>akhiri dengan CSE
>
>Copas kebawah
>
>
>Wassalam
>~
Bagus ~
>
>----- Original Message -----
>>From: ris ha [email protected] [belajar-excel]
>>To: [email protected]
>>Sent: Wednesday, September 03, 2014 11:14 AM
>>Subject: [belajar-excel] menghilangkan blank cell dan menurutkan data text
>>[1 Attachment]
>>
>>
>>Assalamu'alaikum. para master excel
>>
>>
>>
>>Mohon saya dibantu lagi.
>>
>>Bagaimanaformulanya untuk menghilangkan cell blanks dan mengurutkan data text
>>seperti pada contoh terlampir
>>
>>
>>Terima kasih.
>>
>>
>
>
>
>
>
>
HK_menghilangkan blank cell dan menurutkan data text (R).xlsm
Description: application/vnd.ms-excel.sheet.macroenabled.12
