Membuka Proteksi Workbook Excel Tanpa Merubah Link

Sebagai upgrade dari posting sebelumnya, kali ini saya akan menambahkan trik utk membuka proteksi workbook excel anda tanpa mematikan fungsi dan link data dalam file

Mohon diperhatikan bahwa trik ini adalah utk membuka file anda sendiri dan ingat konsekuensi yg mungkin anda dapatkan bila menggunakan trik ini utk kepentingan selain membuka password sheet excel file anda yg terlupa.


Caranya adalah sbb:

Pertama-tama

Buatlah kode berikut dalam module visual basic dalam file excel anda:



Sub Open_Password()


Const DBLSPACE As String = vbNewLine & vbNewLine

Const AUTHORS As String = DBLSPACE & vbNewLine

Const HEADER As String = "AllInternalPasswords User Message"

Const VERSION As String = DBLSPACE & "Version 1.0 8 Sep 2012"

Const REPBACK As String = DBLSPACE & "Please report failure to alfi.sahri1983@gmail.com "

Const ALLCLEAR As String = DBLSPACE & "The workbook should be cleared"

Const MSGNOPWORDS1 As String = "There were no passwords on " & AUTHORS & VERSION

Const MSGNOPWORDS2 As String = "There was no protection to " & "workbook structure or windows." & DBLSPACE


Const MSGTAKETIME As String = "After pressing OK button this " & "will take some time." & DBLSPACE & "Amount of time " & "depends on how many different passwords, the "



Const MSGPWORDFOUND1 As String = "You had a Worksheet " & "Structure or Windows Password set." & DBLSPACE & "The password found was: " & DBLSPACE & "$$" & DBLSPACE & "Note it down for potential future use in other workbooks by " & "the same person who set this password." & DBLSPACE & "Now to check and clear other passwords." & AUTHORS & VERSION

Const MSGPWORDFOUND2 As String = "You had a Worksheet " & "password set." & DBLSPACE & "The password found was: " & DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & "future use in other workbooks by same person who " & "set this password." & DBLSPACE & "Now to check and clear " & "other passwords." & AUTHORS & VERSION

Const MSGONLYONE As String = "Only structure / windows " & "protected with the password that was just found." & ALLCLEAR & AUTHORS & VERSION & REPBACK

Dim w1 As Worksheet, w2 As Worksheet

Dim i As Integer, j As Integer, k As Integer, l As Integer

Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer

Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

Dim PWord1 As String

Dim ShTag As Boolean, WinTag As Boolean

Application.ScreenUpdating = False

With ActiveWorkbook

WinTag = .ProtectStructure Or .ProtectWindows

End With

ShTag = False

For Each w1 In Worksheets

ShTag = ShTag Or w1.ProtectContents

Next w1

If Not ShTag And Not WinTag Then

MsgBox MSGNOPWORDS1, vbInformation, HEADER

Exit Sub

End If

MsgBox MSGTAKETIME, vbInformation, HEADER

If Not WinTag Then

MsgBox MSGNOPWORDS2, vbInformation, HEADER

Else

On Error Resume Next

Do 'dummy do loop

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66

For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

With ActiveWorkbook

.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If .ProtectStructure = False And .ProtectWindows = False Then

PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

MsgBox Application.Substitute(MSGPWORDFOUND1, "$$", PWord1), vbInformation, HEADER

Exit Do 'Bypass all for...nexts

End If

End With

Next: Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next

Loop Until True

On Error GoTo 0

End If

If WinTag And Not ShTag Then

MsgBox MSGONLYONE, vbInformation, HEADER

Exit Sub

End If

On Error Resume Next

For Each w1 In Worksheets

'Attempt clearance with PWord1

w1.Unprotect PWord1

Next w1

On Error GoTo 0

ShTag = False

For Each w1 In Worksheets

'Checks for all clear ShTag triggered to 1 if not.

ShTag = ShTag Or w1.ProtectContents

Next w1

If ShTag Then

For Each w1 In Worksheets

With w1

If .ProtectContents Then

On Error Resume Next

Do 'Dummy do loop

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66

For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If Not .ProtectContents Then

PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

MsgBox Application.Substitute(MSGPWORDFOUND2, "$$", PWord1), vbInformation, HEADER

'leverage finding Pword by trying on other sheets

For Each w2 In Worksheets

w2.Unprotect PWord1

Next w2

Exit Do 'Bypass all for...nexts

End If

Next: Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next

Loop Until True

On Error GoTo 0

End If

End With

Next w1

End If

MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
'
End Sub

Setelah itu anda bisa jalankan makro excel anda dan lihat hasilnya.


Semoga membantu.


Terima kasih
Alfi

Countif Lebih Dari Satu Kriteria Dengan Kriteria Content Cell

Para Pembaca,


Kali ini saya akan share satu trik yg bisa digunakan utk melakukan perhitungan countif tetapi dengan menggunakan beberapa kriteria dimana salah satu atau lebih kriteria yg di akan ditentukan adalah part/bagian dari content (Isi) cell pada suatu range.

Contohnya adalah sebagai berikut:

Buatlah sebuah worksheet dengan menggunakan data dan formula seperti pada contoh dibawah ini,

pada contoh ini; saya misalkan criteria data yg akan dihitung countif nya adalah: criteria 1 = Cust A, Criteria 2 = "Damage", Criteria 3 = Cell yg memiliki content "BGA" didalamnya.

Utk memudahkah perhitungan, buatlah satu formula di column E dengan contoh spt gambar diatas.

Tujuannya adalah utk menentukan ada tidaknya content "BGA" pada data di kolom D atau criteria3. Apabila terdapat content BGA maka nilai di cell D3 maka value pada kolom E adalah 1, dan jika tidak maka isi cell tsb adalah 0.:


Kemudian buat sebuah formula pada cell E13 utk menentukan hasil countif, contoh sebagai berikut

Setelah itu cek hasilnya, hasil count data yg benar = 2.


Mudah-mudahan bermanfaat.


Terima kasih,
Alfi

Memfilter Data Unik Dengan Formula

Berikut akan saya jelaskan mengenai cara yg bisa kita gunakan untuk memfilter sejumlah data berdasarkan data unik (Unique Record) dengan menggunakan formula.

Kelebihannya adalah, bila data yang menjadi acuan adalah data dinamis yg bisa selalu berubah, maka data unik yg kita filter pun bisa menjadi data yang dinamis tanpa perlu berulang kali menggunakan menu advance filter atau tanpa perlu melakukan pivoting.

Stepnya adalah sebagai berikut:

Coba buatlah data pada cell B2:B15 pada worksheet excel anda, berikut sebagai contoh;

kemudian pada cell D2 anda ketikkan formula sebagai berikut:

=INDEX( $B$2:$B$15,MATCH(0,COUNTIF($D$1:D1,$B$2:$15),0))

ini adalah CSE formula jadi tekan Control+Shift+Enter saat anda selesai menuliskan formula di atas.

kemudian tarik (Drag) formula tersebut ke cell D3:D15

anda bisa melihat bahwa data unik dari cell B2:B15 sudah terekstrak.

Silahkan tinggalkan comment apabila pertanyaan;


Terima kasih,
Alfi

Menjumlah Berdasarkan Warna

Ada satu trik yg saya sukai, yaitu menjumlakan suatu data berdasarkan warna latar pada cellnya.

Berikut cara yang bisa digunakan.

Pertama bukalah worksheet anda dan buat data seperti gambar di sebelah.

Kemudian berilah warna latar sesuai kriteria data anda, misalkan data A menggunakan warna kuning (yellow), data B menggunakan warna merah (Red).


Setelah itu pada menu pilih insert -> name -> define.


Pada menu define name -> names in workbook: ketikkan "NomorWarna" tanpa tanda kutip.

pada menu yg sama di "refers to" ketikkan =GET.CELL(38,C4) dan enter.

Pada worksheet anda letakkan kursor pada cell B4 dan ketikkan =NomorWarna

Kemudian copy kan ke bawah sesuai banyaknya data.


Setelah itu akan muncul nomor sesuai warna yg berikan pada cell data.

Untuk menjumlahkan data anda bisa menggunakan fungsi sumif biasa.

Pada cell H4 tuliskan =SUMIF(B4:B9,F4,D4:D9)

tetapi sebelumnya masukkan =NomorWarna pada cell F4 sebagai criteria sumif.

Demikian selamat mencoba.


Terima kasih
Alfi

Membuka Proteksi Worksheet Excel Dengan Macro

Beberapa waktu yang lalu, ada seseorang teman yang terlihat cukup stress karena lupa password proteksi file excel nya sendiri sehingga dia tidak bisa menyelesaikan laporan yg sudah dead line.

Saya coba berikan solusi untuk membantunya membuka proteksi file excelnya dengan sedikit bantuan macro,

caranya adalah sebagai berikut:

ketikkan script berikut pada visual basic editor pada file excel yg akan dibuka proteksinya.

Sub InternalPasswords()

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveWorkbook.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _
& Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _
& Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If ActiveWorkbook.ProtectStructure = False Then

If ActiveWorkbook.ProtectWindows = False Then

If ActiveSheet.ProtectContents = False Then

Exit Sub

End If

End If

End If

Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub

Selanjutnya, buka worksheet yg akan dibuka proteksinya lalu jalankan macro pada menu tools -> Macro

kemudian tekan alt+F11 untuk kembali bekerja pada worksheet anda yang telah terbuka proteksinya.


Salam.

Fungsi Excel ; Mengetahui Jumlah Data Unik

Formula berikut digunakan untuk mengetahui apakah data merupakan data unik, kelebihannya juga adalah dengan fungsi ini kita akan mengetahui berapa jumlah data pada kolom yang merupakan data unik.

Untuk mencobanya pertama-tama buatlah sebuah worksheet dengan beberapa data dalam satu kolom, misalnya kolom B mulai dari row (baris) 1 sampai dengan 10.

Kemudian pada C2 ketikan formula sebagai berikut:

=IF(COUNTIF($B$2:$B$10,B2)=1,"Data Unik",COUNTIF($B$2:$B$10,B2)&" Data Kembar")

kemudian copy rumusnya sampai ke baris terakhir.

Akan muncul pada kolom C apabila data di kolom b merupakan data unik maka tertulis "Data Unik" tetapi apabila terdapat data yang sama pada kolom tersebut pada cell akan tertulis jumlah data yang sama atau kembar.


bagaimana tidak terlalu sulit kan?

Selamat mencoba..!


Alfi

Fungsi Excel ; Average If

Sudah lama nggak posting,

nggak tau kenapa hari ini suasana hati mampu menggerakkan kedua jari untuk menulis.

Beberapa waktu lalu seorang rekan di kantor bertanya ada nggak formula average tetapi dengan kriteria.

Kali ini saya akan mencoba membagikan jawabannya..

Fungsi average if digunakan untuk mengetahui nilai rata dari suatu range dengan kriteria yang telah kita tentukan

Langkahnya adalah sebagai berikut:

bukalah visual basic editor pada microsoft excel anda dan ketiklah module berikut:

Function averageif(range, kriteria, ave_range)
iconditioncolno = range.Column
inumbercolno = ave_range.Column


For lrowno = 1 To range.Rows.Count
vcellvalue = range.Parent.Cells(range.Row + lrowno - 1, inumberscolno.Value)
If IsNumeric(vcellvalue) = True Then
If (range.Parent.Cells(range.Row + lrowno - 1, iconditioncolno).Value = kriteria) Then
lmatch = lmatch + 1
sngaverage = sngaverage + range.Parent.Cells(range.Row + lrowno - 1, inumbercolno).Value
End If
End If

If sngaverage <> 0 And IsEmpty(vcellvalue) = True Then Exit For
End If
Next lrowno
averageif = sngaverage / lmatch

End Function


Save file excel dan kembalilah ke worksheet anda

anda sudah bisa menggunkan fungsi =averageif pada worksheet anda.


Selamat mencoba...