gini lho ya...
1.
penentuan range sekolom penuh padahal isinya hanya 1000 data misalnya,
walaupun serba sedikit, tentu akan mempengaruhi speed pencarian.
ibaratnya mencari orang tertentu dlm lingkungan RT tentu lebih cepat daripada
mencari orang dlm lingkungan kabupaten.
maka pemakaian Range("A2:A65536") kita hindari
Dengan makro kita ada kemudahan membuat range dinamis yg lingkup
seleksinya pas dengan data yg ada saja. (lihat: Set Range_Cari)
2
Mencari dengan metoda FIND katanya memang lebih cepat
tetapi kalau pemrogramannya menjadi lebih sulit (dan panjang), padahal
range daerah pencariannya sudah tertentu, maka menurut fendafatku
lebih simpel pencarian dengan looping atau dengan pinjam fungsi MATCH
milik worksheet.
Dengan match (yg menghasilkan index row, maka data sebaris sudah
di tangan kita semua (nama, pass dan data lain dikanannya jika ada)
3.
berikut ini code vba yg kerjaannya mengganti password untuk nama tertentu
tetapi sebelumnya memeriksa kebenarannya (nama ada di tabel, passwor lama
cocok dgn data ditabel, pasword baru 1 dan 2 identik)
dan bukan membuat menu seperti permintaan pada email...
Asumsi-asumsi
Tabel dianggap ditulis mulai di A1 di sheet2)
pada saat tombok di klik, semua textbox SUDAH terisi
(dimakronya belum ada validasi mengenai isi/kosong nya para textbod ini)
4.
Versi dan cara lain tentu masih banyak, silakan di eksplore...
' hapsari & siti Vi / 20 oct 2011
' dituis berdua karena belum selesai sudah kena ganti shift
Dim NamaDicari As String, PassDicari As String
Dim Range_Cari As Range, CellDicari As Range
Dim Fun As Object, r As Long
Set Fun = Application.WorksheetFunction
Set Range_Cari = Sheet2.Cells(1).CurrentRegion.Offset(1, 0)
Set Range_Cari = Range_Cari.Resize(Range_Cari.Rows.Count - 1, 1)
With Sheet1
NamaDicari = Sheet1.txtNama
If Fun.CountIf(Range_Cari, NamaDicari) > 0 Then
r = Fun.Match(NamaDicari, Range_Cari, 0)
Else
MsgBox "Nama jelex spt itu ndak ada..!", _
vbExclamation, "Mo Ganti Pass"
Exit Sub
End If
If Not .txtPassLama = Range_Cari(r, 2) Then
MsgBox "password lama tidak sesuai dengan data yg ada", _
vbExclamation, "Mo Ganti Pass"
Exit Sub
End If
If Not .txtPassBaru = .txtPassBaru2 Then
MsgBox "dua kali password baru identik", _
vbExclamation, "Mo Ganti Pass"
Exit Sub
End If
' Proses penulisan Password baru ke tabel setelah lolos uji
Range_Cari(r, 2) = .txtPassBaru
Range_Cari(r, 4) = Now
Range_Cari(r, 4).NumberFormat = "dd-mmm-yyyy hh:mm:ss"
MsgBox "Makasih anda sudah mengubah password anda", _
vbInformation, "Mo Ganti Pass"
End With
End Sub
'-------
lupa kiboard-short-cut di excel???
mudah-mudahan tidak terlalu banyak yg salah....
'-------
lupa kiboard-short-cut di excel???
daftarnya ada di sini:. http://www.box.net/shared/h0k1ds7gg3frypr67t1h
2011/10/19 iskandar wagimin harjo prawiro <nomor_pribadi@yahoo.co.id>
>
> Saya tengah membuat aplikasi yang digunakan oleh beberapa user. Setiap user diharuskan untuk login dengan memasukan username dan password. Untuk menunjang aplikasi agar lebih user friendly maka saya ingin menambahkan menu ganti password, namun saya terkendala dalam membuat menu tersebut. Saya mencoba dengan menggunakan cara find kemudian di offset baru diganti passwornnya, namun script saya masih belum benar maklum masih belajar.
>
> Private Sub gantipass_Click()
> Dim seleksicari As Range
> Dim cari As String
> cari = Sheets("Sheet1").nama.Text
> Set seleksicari = wspass.Range("A2:A65536")
> seleksicari.Find(What:=cari, After:=ActiveCell, LookIn:=xlValues, _
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False, SearchFormat:=False).Activate
> 'sampai bagian ini belum berhasil, jd penulisan scriptnya belum dilanjutkan...
> End Sub
>
> Mohon bantuan para suhu untuk memberikan pencerahan bagaimana membuat menu ganti password tersebut.
>
> Terima Kasih.
2011/10/19 iskandar wagimin harjo prawiro <nomor_pribadi@yahoo.co.id>
>
> Saya tengah membuat aplikasi yang digunakan oleh beberapa user. Setiap user diharuskan untuk login dengan memasukan username dan password. Untuk menunjang aplikasi agar lebih user friendly maka saya ingin menambahkan menu ganti password, namun saya terkendala dalam membuat menu tersebut. Saya mencoba dengan menggunakan cara find kemudian di offset baru diganti passwornnya, namun script saya masih belum benar maklum masih belajar.
>
> Private Sub gantipass_Click()
> Dim seleksicari As Range
> Dim cari As String
> cari = Sheets("Sheet1").nama.Text
> Set seleksicari = wspass.Range("A2:A65536")
> seleksicari.Find(What:=cari, After:=ActiveCell, LookIn:=xlValues, _
> LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False, SearchFormat:=False).Activate
> 'sampai bagian ini belum berhasil, jd penulisan scriptnya belum dilanjutkan...
> End Sub
>
> Mohon bantuan para suhu untuk memberikan pencerahan bagaimana membuat menu ganti password tersebut.
>
> Terima Kasih.
__._,_.___
+-:: XL-mania ::::::::::::::::::::----------------------------------+
| ayooo... coba cari XL-mania di linkedin.com |
| tanggal 3-4 oktober yahoogroup akan mengalami maintenance. |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
| ayooo... coba cari XL-mania di linkedin.com |
| tanggal 3-4 oktober yahoogroup akan mengalami maintenance. |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
MARKETPLACE
.
__,_._,___
Nenhum comentário:
Postar um comentário