100 coding vba macro

Kode Dasar

Kode VBA ini akan membantu Anda untuk melakukan beberapa tugas dasar dalam sekejap yang sering Anda lakukan di spreadsheet.

1. Tambahkan Nomor Seri

Kode makro ini akan membantu Anda untuk secara otomatis menambahkan nomor seri di lembar Excel Anda.

Setelah Anda menjalankan makro ini, ia akan menampilkan kotak input di mana Anda harus memasukkan nomor maks untuk nomor seri dan setelah itu, ia akan memasukkan angka dalam kolom secara berurutan.

Sub AddSerialNumbers()

Dim i As Integer

On Error GoTo Last

i = InputBox("Enter Value", "Enter Serial Numbers")

For i = 1 To i

ActiveCell.Value = i

ActiveCell.Offset(1, 0).Activate

Next i

Last:Exit Sub

End Sub

2. Masukkan Banyak Kolom

Setelah Anda menjalankan makro ini, ia akan menampilkan kotak input dan Anda harus memasukkan jumlah kolom yang ingin Anda masukkan.

Sub InsertMultipleColumns()

Dim i As Integer

Dim j As Integer ActiveCell.EntireColumn.Select

On Error GoTo Last

i = InputBox("Enter number of columns to insert", "Insert Columns")

For j = 1 To i

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove Next j

Last:Exit Sub

End Sub

3. Masukkan Banyak Baris

Setelah Anda menjalankan makro ini, ia akan menampilkan kotak input dan Anda harus memasukkan jumlah baris yang ingin Anda sisipkan.

Sub InsertMultipleRows()

Dim i As Integer

Dim j As Integer

ActiveCell.EntireRow.Select

On Error GoTo Last

i = InputBox("Enter number of columns to insert", "Insert Columns")

For j = 1 To i

Selection.Insert Shift:=xlToDown,

CopyOrigin:=xlFormatFromRightorAbove

Next j

Last:Exit Sub

End Sub

4. Kolom Fit Otomatis

Secara otomatis cocok dengan semua kolom di lembar kerja Anda.

Kode makro ini akan memilih semua sel di lembar kerja Anda dan secara otomatis menyesuaikan semua kolom.

Sub AutoFitColumns()

Cells.Select

Cells.EntireColumn.AutoFit

End Sub

5. Baris Fit Otomatis

Anda bisa menggunakan kode ini untuk mencocokkan semua baris secara otomatis dalam lembar kerja.

Ketika Anda menjalankan kode ini, kode itu akan memilih semua sel di lembar kerja Anda dan secara otomatis menyesuaikan semua baris.

Sub AutoFitRows()

Cells.Select

Cells.EntireRow.AutoFit

End Sub

6. Hapus Bungkus Teks

Kode ini akan membantu Anda menghapus bungkus teks dari seluruh lembar kerja dengan satu klik. Pertama-tama akan memilih semua kolom dan kemudian menghapus bungkus teks dan otomatis cocok dengan semua baris dan kolom.

Sub RemoveWrapText()

Cells.Select

Selection.WrapText = False

Cells.EntireRow.AutoFit

Cells.EntireColumn.AutoFit

End Sub

7. Unmerge Cells

Pilih sel Anda dan jalankan kode ini dan itu akan membatalkan penggabungan semua sel dari seleksi dengan data Anda yang hilang.

Sub UnmergeCells()

Selection.UnMerge

End Sub

8. Buka Kalkulator

Di jendela ada kalkulator khusus dan dengan menggunakan kode makro ini Anda dapat membuka kalkulator itu langsung dari Excel untuk perhitungan Anda.

Sub OpenCalculator()

Application.ActivateMicrosoftApp Index:=0

End Sub

9. Tambahkan Tanggal Header / Footer

Gunakan kode ini untuk menambahkan tanggal ke header atau footer di lembar kerja Anda.

Anda dapat mengedit kode ini untuk beralih dari header ke footer.

Sub dateInHeader()

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = "&D"

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

End With

ActiveWindow.View = xlNormalView

End Sub

10. Custom Header / Footer

Jika Anda ingin menyisipkan tajuk khusus maka kode ini untuk Anda.

Jalankan kode ini, masukkan nilai khusus di kotak input. Untuk mengubah perataan header atau footer, Anda dapat mengedit kode.

Sub customHeader()

Dim myText As Stringmy

Text = InputBox("Enter your text here", "Enter Text")

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = myText

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

End Sub

Memformat Kode

Kode VBA ini akan membantu Anda untuk memformat sel dan rentang menggunakan beberapa kriteria dan ketentuan tertentu.

11. Sorot Duplikat dari Pilihan

Makro ini akan memeriksa setiap sel pilihan Anda dan menyoroti nilai duplikat .

Anda juga dapat mengubah warna dari kode.

Sub HighlightDuplicateValues()

Dim myRange As Range

Dim myCell As Range

Set myRange = Selection

For Each myCell In myRange

If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then

myCell.Interior.ColorIndex = 36

End If

Next myCell

End Sub

12. Sorot Baris dan Kolom Aktif

Saya sangat suka menggunakan kode makro ini setiap kali saya harus menganalisis tabel data.

Inilah langkah-langkah cepat untuk menerapkan kode ini.

1. Buka VBE (ALT + F11).

2. Pergi ke Project Explorer (Ctrl + R, If hidden).

3. Pilih buku kerja Anda & klik dua kali pada nama lembar kerja tertentu di mana Anda ingin mengaktifkan makro.

4. Tempel kode ke dalamnya dan pilih "BeforeDoubleClick" dari menu drop down acara.

5. Tutup VBE dan Anda selesai.

Ingat bahwa, dengan menerapkan makro ini Anda tidak akan dapat mengedit sel dengan mengklik dua kali.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,

Cancel As Boolean)

Dim strRange As String

strRange = Target.Cells.Address & "," Target.Cells.EntireColumn.Address & "," & _

Target.Cells.EntireRow.Address

Range(strRange).Select

End Sub

13. Sorot 10 Nilai Teratas

Cukup pilih rentang dan jalankan makro ini dan itu akan menyoroti 10 nilai teratas dengan warna hijau.

Sub TopTen()

Selection.FormatConditions.AddTop10

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.TopBottom = xlTop10Top

.Rank = 10

.Percent = False

End With

With Selection.FormatConditions(1).Font

.Color = -16752384

.TintAndShade = 0

End With

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 13561798

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = False

End Sub

14. Sorot Named Ranges

Jika Anda tidak yakin tentang berapa rentang bernama yang Anda miliki di lembar kerja Anda, maka Anda bisa menggunakan kode ini untuk menyorot semuanya.

Sub HighlightRanges()

Dim RangeName As Name

Dim HighlightRange As Range

On Error Resume Next

For Each RangeName In ActiveWorkbook.Names

Set HighlightRange = RangeName.RefersToRange

HighlightRange.Interior.ColorIndex = 36

Next RangeName

End Sub

15. Sorot Lebih Besar dari Nilai

Setelah Anda menjalankan kode ini, ia akan meminta Anda nilai dari mana Anda ingin menyorot semua nilai yang lebih besar.

Sub HighlightGreaterThanValues()

Dim i As Integer

i = InputBox("Enter Greater Than Value", "Enter Value")

Selection.FormatConditions.Delete

Selection.FormatConditions.Add Type:=xlCellValue,

Operator:=xlGreater, Formula1:=i

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.Font.Color = RGB(0, 0, 0)

.Interior.Color = RGB(31, 218, 154)

End With

End Sub

16. Sorot Nilai Lebih Rendah Daripada

Setelah Anda menjalankan kode ini, ia akan meminta Anda nilai dari mana Anda ingin menyorot semua nilai yang lebih rendah.

Sub HighlightLowerThanValues()

Dim i As Integer

i = InputBox("Enter Lower Than Value", "Enter Value")

Selection.FormatConditions.Delete

Selection.FormatConditions.Add Type:=xlCellValue,

Operator:=xlLower, Formula1:=i

Selection.FormatConditions(Selection.FormatConditions.Count).S

tFirstPriority

With Selection.FormatConditions(1)

.Font.Color = RGB(0, 0, 0)

.Interior.Color = RGB(217, 83, 79)

End With

End Sub

17. Sorot Angka Negatif

Pilih rentang sel dan jalankan kode ini. Ini akan memeriksa setiap sel dari rentang dan menyorot semua sel di mana Anda memiliki angka negatif.

Sub highlightNegativeNumbers()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsNumber(Rng) Then

If Rng.Value < 0 Then

Rng.Font.Color= -16776961

End If

End If

Next

End Sub

18. Sorot Teks Tertentu

Misalkan Anda memiliki kumpulan data besar dan Anda ingin memeriksa nilai tertentu. Untuk ini, Anda dapat menggunakan kode ini. Saat Anda menjalankannya, Anda akan mendapatkan kotak input untuk memasukkan nilai yang akan dicari.

Sub highlightValue()

Dim myStr As String

Dim myRg As Range

Dim myTxt As String

Dim myCell As Range

Dim myChar As String

Dim I As Long

Dim J As Long

On Error Resume Next

If ActiveWindow.RangeSelection.Count> 1 Then

myTxt= ActiveWindow.RangeSelection.AddressLocal

Else

myTxt= ActiveSheet.UsedRange.AddressLocal

End If

LInput: Set myRg= Application.InputBox("please select the data

range:", "Selection Required", myTxt, , , , , 8)

If myRg Is Nothing Then

Exit Sub

If myRg.Areas.Count > 1 Then

MsgBox"not support multiple columns" GoToLInput

End If

If myRg.Columns.Count <> 2 Then

MsgBox"the selected range can only contain two columns "

GoTo LInput

End If

For I = 0 To myRg.Rows.Count-1

myStr= myRg.Range("B1").Offset(I, 0).Value

With myRg.Range("A1").Offset(I, 0)

.Font.ColorIndex= 1

For J = 1 To Len(.Text)

Mid(.Text, J, Len(myStr)) = myStrThen

.Characters(J, Len(myStr)).Font.ColorIndex= 3

Next

End With

Next I

End Sub

19. Sorot Sel dengan Komentar

Untuk menyorot semua sel dengan komentar, gunakan makro ini.

Sub highlightCommentCells()

Selection.SpecialCells(xlCellTypeComments).Select

Selection.Style= "Note"

End Sub

20. Sorot Baris Alternatif dalam Pilihan

Dengan menyorot baris alternatif, Anda dapat membuat data Anda mudah dibaca. Dan untuk ini, Anda dapat menggunakan kode VBA di bawah ini. Ini hanya akan menyorot setiap baris alternatif dalam rentang yang dipilih.

Sub highlightAlternateRows()

Dim rng As Range

For Each rng In Selection.Rows

If rng.RowMod 2 = 1 Then

rng.Style= "20% -Accent1"

rng.Value= rng^ (1 / 3)

Else

End If

Next rng

End Sub

21. Sorot Sel dengan Kata yang Dieja Salah

Jika Anda merasa sulit untuk memeriksa semua sel untuk kesalahan ejaan maka kode ini untuk Anda. Ini akan memeriksa setiap sel dari seleksi dan menyorot sel di mana kata yang salah eja.

Sub HighlightMisspelledCells()

Dim rng As Range

For Each rng In ActiveSheet.UsedRange

If Not Application.CheckSpelling(word:=rng.Text) Then

rng.Style= "Bad" End If

Next rng

End Sub

22. Sorot Sel Dengan Kesalahan di Seluruh Lembar Kerja

Untuk menyorot dan menghitung semua sel tempat Anda memiliki kesalahan, kode ini akan membantu Anda. Jalankan saja kode ini dan itu akan mengembalikan pesan dengan jumlah sel kesalahan dan sorot semua sel.

Sub highlightErrors()

Dim rng As Range

Dim i As Integer

For Each rng In ActiveSheet.UsedRange

If WorksheetFunction.IsError(rng) Then

i = i + 1 rng.Style = "bad"

End If

Next rng

MsgBox "There are total " & i & " error(s) in this worksheet."

End Sub

23. Sorot Sel dengan Teks Tertentu dalam Lembar Kerja

Kode ini akan membantu Anda menghitung sel yang memiliki nilai spesifik yang akan Anda sebutkan dan setelah itu menyorot semua sel itu.

Sub highlightSpecificValues()

Dim rng As Range

Dim i As Integer

Dim c As Variant

c = InputBox("Enter Value To Highlight")

For Each rng In ActiveSheet.UsedRange

If rng = c Then

rng.Style = "Note"

i = i + 1

End If

Next rng

MsgBox "There are total " & i &" "& c & " in this worksheet."

End Sub

24. Sorot semua Sel Kosong yang Tak Terlihat

Kadang-kadang ada beberapa sel yang kosong tetapi mereka memiliki ruang tunggal dan karena ini, sangat sulit untuk mengidentifikasi mereka. Kode ini akan memeriksa semua sel di lembar kerja dan menyorot semua sel yang memiliki ruang tunggal.

Sub blankWithSpace()

Dim rng As Range

For Each rng In ActiveSheet.UsedRange

If rng.Value = " " Then

rng.Style = "Note"

End If

Next rng

End Sub

25. Sorot Nilai Maks Dalam Rentang

Ini akan memeriksa semua sel yang dipilih dan menyorot sel dengan nilai maksimum.

Sub highlightMaxValue()

Dim rng As Range

For Each rng In Selection

If rng = WorksheetFunction.Max(Selection) Then

rng.Style = "Good"

End If

Next rng

End Sub

26. Sorot Nilai Min Di Kisaran

Ini akan memeriksa semua sel yang dipilih dan menyorot sel dengan nilai Minimum.

Sub highlightMinValue()

Dim rng As Range

For Each rng In Selection

If rng = WorksheetFunction.Min(Selection) Then

rng.Style = "Good"

End If

Next rng

End Sub

27. Sorot Nilai-Nilai Unik

Kode ini akan menyoroti semua sel dari seleksi yang memiliki nilai unik.

Sub highlightUniqueValues()

Dim rng As Range

Set rng = Selection

rng.FormatConditions.Delete

Dim uv As UniqueValues

Set uv = rng.FormatConditions.AddUniqueValues

uv.DupeUnique = xlUnique

uv.Interior.Color = vbGreen

End Sub

28. Sorot Perbedaan dalam Kolom

Dengan menggunakan kode ini, Anda dapat menyoroti perbedaan antara dua kolom (sel yang sesuai).

Sub columnDifference()

Range("H7:H8,I7:I8").Select

Selection.ColumnDifferences(ActiveCell).Select

Selection.Style= "Bad"

End Sub

29. Sorot Perbedaan dalam Baris

Dan dengan menggunakan kode ini Anda dapat menyoroti perbedaan antara dua baris (sel yang sesuai).

Sub rowDifference()

Range("H7:H8,I7:I8").Select

Selection.RowDifferences(ActiveCell).Select

Selection.Style= "Bad"

End Sub

Kode Pencetakan

Kode makro ini akan membantu Anda mengotomatiskan beberapa tugas pencetakan yang selanjutnya dapat menghemat banyak waktu.

30. Cetak Komentar

Gunakan makro ini untuk mengaktifkan pengaturan untuk mencetak komentar sel di akhir halaman. Katakanlah Anda memiliki 10 halaman untuk dicetak, setelah menggunakan kode ini Anda akan mendapatkan semua komentar pada halaman terakhir ke-11.

Sub printComments()

With ActiveSheet.PageSetup

.printComments= xlPrintSheetEnd

End With

End Sub

31. Cetak Margin Sempit

Gunakan kode VBA ini untuk mencetak dengan margin sempit. Ketika Anda menjalankan makro ini, secara otomatis akan mengubah margin menjadi sempit.

Sub printNarrowMargin()

With ActiveSheet.PageSetup

.LeftMargin= Application

.InchesToPoints(0.25)

.RightMargin= Application.InchesToPoints(0.25)

.TopMargin= Application.InchesToPoints(0.75)

.BottomMargin= Application.InchesToPoints(0.75)

.HeaderMargin= Application.InchesToPoints(0.3)

.FooterMargin= Application.InchesToPoints(0.3)

End With

ActiveWindow.SelectedSheets.PrintOutCopies:=1, Collate:=True,

IgnorePrintAreas:=False

End Sub

32. Pilihan Cetak

Kode ini akan membantu Anda mencetak kisaran yang dipilih. Anda tidak perlu pergi ke opsi pencetakan dan mengatur rentang pencetakan. Cukup pilih rentang dan jalankan kode ini.

Sub printSelection()

Selection.PrintOutCopies:=1, Collate:=True

End Sub

33. Cetak Halaman Kustom

Alih-alih menggunakan pengaturan dari opsi cetak, Anda dapat menggunakan kode ini untuk mencetak rentang halaman khusus.

Katakanlah Anda ingin mencetak halaman dari 5 hingga 10. Anda hanya perlu menjalankan kode VBA ini dan memasuki halaman mulai dan halaman akhir.

Sub printCustomSelection()

Dim startpageAs Integer

Dim endpageAs Integer

startpage= InputBox("Please Enter Start Page number.", "Enter Value")

If Not WorksheetFunction.IsNumber(startpage) Then

MsgBox"Invalid Start Page number. Please try again.", "Error"

Exit Sub

End If

endpage= InputBox("Please Enter End Page number.", "Enter Value")

If Not WorksheetFunction.IsNumber(endpage) Then

MsgBox"Invalid End Page number. Please try again.", "Error"

Exit Sub

End If

Selection.PrintOutFrom:=startpage, To:=endpage, Copies:=1

Collate:=True

End Sub

Kode Lembar Kerja

Kode makro ini akan membantu Anda mengontrol dan mengelola lembar kerja dengan cara yang mudah dan menghemat banyak waktu Anda.

34. Sembunyikan semua kecuali Lembar Kerja Aktif

Sekarang, katakanlah jika Anda ingin menyembunyikan semua lembar kerja di buku kerja Anda selain lembar kerja aktif. Kode makro ini akan melakukan ini untuk Anda.

Sub HideWorksheet()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> ThisWorkbook.ActiveSheet.Name Then

ws.Visible = xlSheetHidden

End If

Next ws

End Sub

35. Perlihatkan semua Lembar Kerja Tersembunyi

Dan jika Anda ingin membatalkan semua lembar kerja yang telah Anda sembunyikan dengan kode sebelumnya, berikut adalah kode untuk itu.

Sub UnhideAllWorksheet()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets

ws.Visible = xlSheetVisible

Next ws

End Sub

36. Hapus semua kecuali Lembar Kerja Aktif

Jika Anda ingin menghapus semua lembar kerja selain lembar aktif, makro ini berguna untuk Anda.

Saat Anda menjalankan makro ini, ia akan membandingkan nama lembar kerja aktif dengan lembar kerja lain dan kemudian menghapusnya.

Sub DeleteWorksheets()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.name <> ThisWorkbook.ActiveSheet.name Then

Application.DisplayAlerts = False

ws.Delete

Application.DisplayAlerts = True

End If

Next ws

End Sub

37. Lindungi semua Lembar Kerja Secara Instan

Jika Anda ingin melindungi semua lembar kerja Anda sekaligus, ini adalah kode untuk Anda.

Ketika Anda menjalankan makro ini, Anda akan mendapatkan kotak input untuk memasukkan kata sandi. Setelah Anda memasukkan kata sandi, klik OK. Dan pastikan untuk berhati-hati tentang CAPS.

Sub ProtectAllWorskeets()

Dim ws As Worksheet

Dim ps As String

ps = InputBox("Enter a Password.", vbOKCancel)

For Each ws In ActiveWorkbook.Worksheets

ws.Protect Password:=ps

Next ws

End Sub

38. Ubah Ukuran Semua Grafik di Lembar Kerja

Buat semua bagan sama ukurannya. Kode makro ini akan membantu Anda membuat semua bagan dengan ukuran yang sama. Anda dapat mengubah tinggi dan lebar grafik dengan mengubahnya dalam kode makro.

Sub Resize_Charts()

Dim i As Integer

For i = 1 To ActiveSheet.ChartObjects.Count

With ActiveSheet.ChartObjects(i)

.Width = 300

.Height = 200

End With

Next i

End Sub

39. Masukkan Beberapa Lembar Kerja

Anda bisa menggunakan kode ini jika Anda ingin menambahkan beberapa lembar kerja dalam buku kerja Anda dalam satu pemotretan.

Ketika Anda menjalankan kode makro ini, Anda akan mendapatkan kotak input untuk memasukkan jumlah total lembar yang ingin Anda masukkan.

Sub InsertMultipleSheets()

Dim i As Integer

i = InputBox("Enter number of sheets to insert.", "Enter

Multiple Sheets")

Sheets.Add After:=ActiveSheet, Count:=i

End Sub

40. Lindungi Lembar Kerja

Jika Anda ingin melindungi lembar kerja Anda, Anda dapat menggunakan kode makro ini.

Yang harus Anda lakukan cukup sebutkan kata sandi Anda dalam kode.

Sub ProtectWS()

ActiveSheet.Protect "mypassword", True, True

End Sub

41. Un-Protect Worksheet

Jika Anda ingin membuka proteksi lembar kerja Anda, Anda dapat menggunakan kode makro ini.

Yang harus Anda lakukan hanyalah menyebutkan kata sandi yang telah Anda gunakan sambil melindungi lembar kerja Anda.

Sub UnprotectWS()

ActiveSheet.Unprotect "mypassword"

End Sub

42. Sortir Lembar Kerja

Kode ini akan membantu Anda untuk mengurutkan lembar kerja di buku kerja Anda sesuai dengan namanya.

Sub SortWorksheets()

Dim i As Integer

Dim j As Integer

Dim iAnswer As VbMsgBoxResult

iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _

& "Clicking No will sort in Descending Order", _

vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")

For i = 1 To Sheets.Count

For j = 1 To Sheets.Count - 1

If iAnswer = vbYes Then

If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

ElseIf iAnswer = vbNo Then

If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then Sheets(j).Move After:=Sheets(j + 1)

End If

End If

Next j

Next i

End Sub

43. Lindungi semua Sel Dengan Formula

Untuk melindungi sel dengan formula dengan satu klik Anda dapat menggunakan kode ini.

Sub lockCellsWithFormulas()

With ActiveSheet

.Unprotect

.Cells.Locked = False

.Cells.SpecialCells(xlCellTypeFormulas).Locked = True

.Protect AllowDeletingRows:=True

End With

End Sub

44. Hapus semua Lembar Kerja Kosong

Jalankan kode ini dan itu akan memeriksa semua lembar kerja di buku kerja aktif dan menghapus jika lembar kerja kosong.

Sub deleteBlankWorksheets()

Dim Ws As Worksheet

On Error Resume Next

Application.ScreenUpdating= False

Application.DisplayAlerts= False

For Each Ws In Application.Worksheets

If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then

Ws.Delete

End If

Next

Application.ScreenUpdating= True

Application.DisplayAlerts= True

End Sub

45. Perlihatkan semua Baris dan Kolom

Alih-alih menyembunyikan baris dan kolom secara manual, Anda dapat menggunakan kode ini untuk melakukan ini dalam sekali jalan.

Sub UnhideRowsColumns()

Columns.EntireColumn.Hidden = False

Rows.EntireRow.Hidden = False

End Sub

46. ​​Simpan Setiap Lembar Kerja sebagai PDF Tunggal

Kode ini hanya akan menyimpan semua lembar kerja dalam file PDF yang terpisah. Anda hanya perlu mengubah nama folder dari kode.

Sub SaveWorkshetAsPDF()

Dimws As Worksheet

For Each ws In Worksheetsws.ExportAsFixedFormat xlTypePDF,

“ENTER-FOLDER-NAME-HERE" & ws.Name & ".pdf" Nextws

End Sub

47. Nonaktifkan Page Breaks

Untuk menonaktifkan page break gunakan kode ini. Ini hanya akan menonaktifkan istirahat halaman dari semua buku kerja terbuka.

Sub DisablePageBreaks()

Dim wbAs Workbook

Dim wksAs Worksheet

Application.ScreenUpdating= False

For Each wbIn Application.Workbooks

For Each ShtIn wb.WorksheetsSht.DisplayPageBreaks= False

Next Sht

Next wb

Application.ScreenUpdating= True

End Sub

Kode Buku Kerja

Kode-kode ini akan membantu Anda untuk melakukan tugas-tugas tingkat buku kerja dengan cara yang mudah dan dengan upaya minimum.

48. Buat Cadangan Buku Kerja Saat Ini

Ini adalah salah satu makro paling berguna yang dapat membantu Anda menyimpan file cadangan dari buku kerja Anda saat ini.

Ini akan menyimpan file cadangan di direktori yang sama di mana file Anda saat ini disimpan dan juga akan menambahkan tanggal saat ini dengan nama file tersebut.

Sub FileBackUp()

ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _

"" & Format(Date, "mm-dd-yy") & " " & _

ThisWorkbook.name

End Sub

49. Tutup semua Buku Kerja Sekaligus

Gunakan kode makro ini untuk menutup semua buku kerja yang terbuka.

Kode makro ini pertama-tama akan memeriksa semua buku kerja satu per satu dan menutupnya. Jika ada lembar kerja yang tidak disimpan, Anda akan mendapatkan pesan untuk menyimpannya.

Sub CloseAllWorkbooks()

Dim wbs As Workbook

For Each wbs In Workbooks

wbs.Close SaveChanges:=True

Next wb

End Sub

50. Salin Lembar Kerja Aktif ke Buku Kerja Baru

Katakanlah jika Anda ingin menyalin lembar kerja aktif Anda di buku kerja baru, jalankan kode makro ini dan itu akan melakukan hal yang sama untuk Anda.

Ini penghemat waktu super.

Sub CopyWorksheetToNewWorkbook()

ThisWorkbook.ActiveSheet.Copy _

Before:=Workbooks.Add.Worksheets(1)

End Sub

51. Buku Kerja Aktif dalam Email

Gunakan kode makro ini untuk dengan cepat mengirim buku kerja aktif Anda dalam surel.

Anda dapat mengubah subjek, email, dan teks isi dalam kode dan jika Anda ingin mengirim email ini secara langsung, gunakan ".Kirim" bukan ".Display".

Sub Send_Mail()

Dim OutApp As Object

Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

With OutMail

.to = "Sales@FrontLinePaper.com"

.Subject = "Growth Report"

.Body = "Hello Team, Please find attached Growth Report."

.Attachments.Add ActiveWorkbook.FullName

.display

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

52. Tambahkan Buku Kerja ke Lampiran Surat

Setelah Anda menjalankan makro ini, ia akan membuka klien email default Anda dan buku kerja aktif terlampir dengan itu sebagai lampiran.

Sub OpenWorkbookAsAttachment()

Application.Dialogs(xlDialogSendMail).Show

End Sub

53. Pesan Selamat Datang

Anda dapat menggunakan auto_open untuk melakukan tugas membuka file dan yang harus Anda lakukan hanyalah memberi nama makro Anda "auto_open".

Sub auto_open()

MsgBox "Welcome To ExcelChamps & Thanks for downloading this

file."

End Sub

54. Pesan Penutupan

Anda dapat menggunakan close_open untuk melakukan tugas membuka file dan yang harus Anda lakukan hanyalah memberi nama makro Anda "close_open".

Sub auto_close()

MsgBox "Bye Bye! Don't forget to check other cool stuff on

excelchamps.com"

End Sub

55. Hitung Buku Kerja Terbuka yang Tidak Diselamatkan

Mari Anda memiliki 5-10 buku kerja terbuka, Anda dapat menggunakan kode ini untuk mendapatkan jumlah buku kerja yang belum disimpan.

Sub VisibleWorkbooks()

Dim book As Workbook

Dim i As Integer

For Each book In Workbooks

If book.Saved = False Then

i = i + 1

End If

Next book

MsgBox i

End Sub

Kode Tabel Pivot

Kode-kode ini akan membantu Anda mengelola dan membuat beberapa perubahan dalam tabel pivot dalam sekejap.

56. Sembunyikan Subtotal Tabel Pivot

Jika Anda ingin menyembunyikan semua subtotal, jalankan saja kode ini.

Pertama-tama, pastikan untuk memilih sel dari tabel pivot Anda dan kemudian jalankan makro ini.

Sub HideSubtotals()

Dim pt As PivotTable

Dim pf As PivotField

On Error Resume Next

Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.name)

If pt Is Nothing Then

MsgBox "You must place your cursor inside of a PivotTable."

Exit Sub

End If

For Each pf In pt.PivotFields

pf.Subtotals(1) = True

pf.Subtotals(1) = False

Next pf

End Sub

57. Refresh Semua Tabel Pivot

Metode super cepat untuk me-refresh semua tabel pivot .

Jalankan saja kode ini dan semua tabel pivot Anda di buku kerja Anda akan disegarkan dalam satu kesempatan.

Sub CloseAllWorkbooks()

Dim wbs As Workbook

For Each wbs In Workbooks

wbs.Close SaveChanges:=True

Next wb

End Sub

58. Buat Tabel Pivot

Ikuti panduan langkah demi langkah ini untuk membuat tabel pivot menggunakan VBA .

59. Pembaruan Otomatis Rentang Tabel Pivot

Jika Anda tidak menggunakan tabel Excel maka Anda dapat menggunakan kode ini untuk memperbarui rentang tabel pivot .

Sub UpdatePivotTableRange()

Dim Data_Sheet As Worksheet

Dim Pivot_Sheet As Worksheet

Dim StartPoint As Range

Dim DataRange As Range

Dim PivotName As String

Dim NewRange As String

Dim LastCol As Long

Dim lastRow As Long

'Set Pivot Table & Source Worksheet

Set Data_Sheet = ThisWorkbook.Worksheets("PivotTableData3")

Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot3")

'Enter in Pivot Table Name

PivotName = "PivotTable2"

'Defining Staring Point & Dynamic Range

Data_Sheet.Activate

Set StartPoint = Data_Sheet.Range("A1")

LastCol = StartPoint.End(xlToRight).Column

DownCell = StartPoint.End(xlDown).Row

Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))

NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)

'Change Pivot Table Data Source Range Address

Pivot_Sheet.PivotTables(PivotName). _

ChangePivotCache ActiveWorkbook. _

PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

'Ensure Pivot Table is Refreshed

Pivot_Sheet.PivotTables(PivotName).RefreshTable

'Complete Message

Pivot_Sheet.Activate

MsgBox "Your Pivot Table is now updated."

End Sub

60. Nonaktifkan / Aktifkan Dapatkan Data Pivot

Untuk menonaktifkan / mengaktifkan fungsi GetPivotData, Anda perlu menggunakan opsi Excel.

Tetapi dengan kode ini Anda dapat melakukannya dalam satu klik.

Sub activateGetPivotData()

Application.GenerateGetPivotData = True

End Sub

Sub deactivateGetPivotData()

Application.GenerateGetPivotData = False

End Sub

Kode Bagan

Gunakan kode VBA ini untuk mengelola bagan di Excel dan menghemat banyak waktu Anda.

61. Ubah Jenis Bagan

Kode ini akan membantu Anda mengonversi jenis bagan tanpa menggunakan opsi bagan dari tab.

Yang harus Anda lakukan hanyalah menentukan jenis yang ingin Anda konversi.

Kode di bawah ini akan mengkonversi bagan yang dipilih ke bagan kolom berkerumun.

Ada berbagai kode untuk berbagai jenis, Anda dapat menemukan semua jenis itu dari sini .

Sub ChangeChartType()

ActiveChart.ChartType = xlColumnClustered

End Sub

62. Tempelkan Bagan sebagai Gambar

Kode ini akan membantu Anda untuk mengubah bagan Anda menjadi gambar.

Anda hanya perlu memilih bagan Anda dan menjalankan kode ini.

Sub ConvertChartToPicture()

ActiveChart.ChartArea.Copy

ActiveSheet.Range("A1").Select

ActiveSheet.Pictures.Paste.Select

End Sub

63. Tambahkan Judul Bagan

Pertama-tama, Anda harus memilih bagan Anda dan menjalankan kode ini.

Anda akan mendapatkan kotak input untuk memasukkan judul bagan.

Sub AddChartTitle()

Dim i As Variant

i = InputBox("Please enter your chart title", "Chart Title")

On Error GoTo Last

ActiveChart.SetElement (msoElementChartTitleAboveChart)

ActiveChart.ChartTitle.Text = i

Last:

Exit Sub

End Sub

Kode Lanjutan

Beberapa kode yang dapat Anda gunakan untuk membentuk sebelumnya tugas canggih di spreadsheet Anda.

64. Simpan Rentang yang Dipilih sebagai PDF

Jika Anda ingin menyembunyikan semua subtotal, jalankan saja kode ini.

Pertama-tama, pastikan untuk memilih sel dari tabel pivot Anda dan kemudian jalankan makro ini.

Sub HideSubtotals()

Dim pt As PivotTable

Dim pf As PivotField

On Error Resume Next

Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.n ame)

If pt Is Nothing Then

MsgBox "You must place your cursor inside of a PivotTable."

Exit Sub

End If

For Each pf In pt.PivotFields

pf.Subtotals(1) = True

pf.Subtotals(1) = False

Next pf

End Sub

65. Buat Daftar Isi

Katakanlah Anda memiliki lebih dari 100 lembar kerja di buku kerja Anda dan sulit dinavigasi sekarang.

Jangan khawatir kode makro ini akan menyelamatkan segalanya.

Saat Anda menjalankan kode ini, itu akan membuat lembar kerja baru dan membuat indeks lembar kerja dengan hyperlink ke sana.

Sub TableofContent()

Dim i As Long

On Error Resume Next

Application.DisplayAlerts = False

Worksheets("Table of Content").Delete

Application.DisplayAlerts = True

On Error GoTo 0

ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)

ActiveSheet.Name = "Table of Content"

For i = 1 To Sheets.Count

With ActiveSheet

.Hyperlinks.Add _

Anchor:=ActiveSheet.Cells(i, 1), _

Address:="", _

SubAddress:="'" & Sheets(i).Name & "'!A1", _

ScreenTip:=Sheets(i).Name, _

TextToDisplay:=Sheets(i).Name

End With

Next i

End Sub

66. Ubah Rentang menjadi Gambar

Rekatkan rentang yang dipilih sebagai gambar.

Anda hanya perlu memilih rentang dan setelah Anda menjalankan kode ini akan secara otomatis menyisipkan gambar untuk rentang itu .

Sub PasteAsPicture()

Application.CutCopyMode = False

Selection.Copy

ActiveSheet.Pictures.Paste.Select

End Sub

67. Masukkan Gambar Tertaut

Kode VBA ini akan mengubah rentang yang dipilih menjadi gambar yang ditautkan dan Anda dapat menggunakan gambar itu di mana pun Anda inginkan.

Sub LinkedPicture()

Selection.Copy

ActiveSheet.Pictures.Paste(Link:=True).Select

End Sub

68. Gunakan Text to Speech

Cukup pilih rentang dan jalankan kode ini.

Excel akan berbicara semua teks apa yang Anda miliki dalam rentang itu, sel demi sel.

Sub Speak()

Selection.Speak

End Sub

69. Aktifkan Formulir Entri Data

Ada formulir entri data default  yang dapat Anda gunakan untuk entri data.

Sub DataForm()

ActiveSheet.ShowDataForm

End Sub

70. Gunakan Goal Seek

Goal Seek bisa sangat membantu bagi Anda untuk menyelesaikan masalah yang kompleks.

Pelajari lebih lanjut tentang pencarian sasaran dari sini sebelum Anda menggunakan kode ini.

Sub GoalSeekVBA()

Dim Target As Long

On Error GoTo Errorhandler

Target = InputBox("Enter the required value", "Enter Value")

Worksheets("Goal_Seek").Activate

With ActiveSheet .Range("C7")

.GoalSeek_ Goal:=Target, _

ChangingCell:=Range("C2")

End With

Exit Sub

Errorhandler: MsgBox("Sorry, value is not valid.")

End Sub

71. Kode VBA untuk Pencarian di Google

Ikuti posting ini untuk mempelajari cara menggunakan kode VBA ini untuk mencari di Google .

Sub SearchWindow32()

Dim chromePath As String

Dim search_string As String

Dim query As String

query = InputBox("Enter here your search here", "Google Search")

search_string = query

search_string = Replace(search_string, " ", "+")

'Uncomment the following line for Windows 64 versions and comment out Windows 32 versions'

chromePath = "C:Program

FilesGoogleChromeApplicationchrome.exe"

'Uncomment the following line for Windows 32 versions and comment out Windows 64 versions

chromePath = "C:Program Files

(x86)GoogleChromeApplicationchrome.exe"

Shell (chromePath & " -url http://google.com/#q=" & search_string)

End Sub

Kode Formula

Kode-kode ini akan membantu Anda menghitung atau mendapatkan hasil yang sering Anda lakukan dengan fungsi dan formula lembar kerja.

72. Ubah semua Rumus menjadi Nilai

Konversi rumus menjadi nilai.

Saat Anda menjalankan makro ini, ia akan dengan cepat mengubah rumus menjadi nilai absolut .

Sub ConvertToValues()

Dim MyRange As Range

Dim MyCell As Range

Select Case MsgBox("You Can't Undo This Action. " & "Save

Workbook First?", vbYesNoCancel, "Alert")

Case Is = vbYes

ThisWorkbook.Save

Case Is = vbCancel

Exit Sub

End Select

Set MyRange = Selection

For Each MyCell In MyRange

If MyCell.HasFormula Then

MyCell.Formula = MyCell.Value

End If

Next MyCell

End Sub

73. Hapus Spasi dari Sel yang Dipilih

Salah satu makro paling berguna dari daftar ini.

Ini akan memeriksa pilihan Anda dan kemudian menghapus semua ruang ekstra dari itu.

Sub RemoveSpaces()

Dim myRange As Range

Dim myCell As Range

Select Case MsgBox("You Can't Undo This Action. " & "Save

Workbook First?", _

vbYesNoCancel, "Alert")

Case Is = vbYesThisWorkbook.Save

Case Is = vbCancel

Exit Sub

End Select

Set myRange = Selection

For Each myCell In myRange

If Not IsEmpty(myCell) Then

myCell = Trim(myCell)

End If

Next myCell

End Sub

74. Hapus Karakter dari String

Cukup hapus karakter dari awal string teks.

Yang Anda butuhkan hanyalah merujuk ke sel atau memasukkan teks ke dalam fungsi dan jumlah karakter yang akan dihapus dari string teks.

Ini memiliki dua argumen "rng" untuk string teks dan "cnt" untuk menghapus jumlah karakter.

Misalnya: Jika Anda ingin menghapus karakter pertama dari sel , Anda harus memasukkan 1 dalam cnt.

Public Function removeFirstC(rng As String, cnt As Long)

removeFirstC = Right(rng, Len(rng) - cnt)

End Function

75. Tambahkan Simbol Gelar Sisipkan di Excel

Katakanlah Anda memiliki daftar angka di kolom dan Anda ingin menambahkan simbol derajat dengan semuanya.

Sub degreeSymbol( )

Dim rng As Range

For Each rng In Selection

rng.Select

If ActiveCell <> "" Then

If IsNumeric(ActiveCell.Value) Then

ActiveCell.Value = ActiveCell.Value & "°"

End If

End If

Next

End Sub

76. Membalikkan Teks

Yang harus Anda lakukan hanyalah memasukkan fungsi "rvrse" dalam sel dan merujuk ke sel di mana Anda memiliki teks yang ingin Anda balikkan.

Public Function rvrse(ByVal cell As Range) As String

rvrse = VBA.strReverse(cell.Value)

End Function

77. Aktifkan Gaya Referensi R1C1

Kode makro ini akan membantu Anda untuk mengaktifkan gaya referensi R1C1 tanpa menggunakan opsi Excel.

Sub DataForm()

ActiveSheet.ShowDataForm

End Sub

78. Aktifkan Gaya Referensi A1

Kode makro ini akan membantu Anda untuk mengaktifkan gaya referensi A1 tanpa menggunakan opsi Excel.

Sub ActivateA1()

If Application.ReferenceStyle = xlR1C1 Then

Application.ReferenceStyle = xlA1

Else

Application.ReferenceStyle = xlA1

End If

End Sub

79. Masukkan Rentang Waktu

Dengan kode ini, Anda dapat memasukkan rentang waktu secara berurutan mulai pukul 00:00 hingga 23:00.

Sub TimeStamp()

Dim i As Integer

For i = 1 To 24

ActiveCell.FormulaR1C1 = i & ":00"

ActiveCell.NumberFormat = "[$-409]h:mm AM/PM;@"

ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select

Next i

End Sub

80. Ubah Tanggal menjadi Hari

Jika Anda memiliki tanggal di lembar kerja Anda dan Anda ingin mengonversi semua tanggal tersebut menjadi hari maka kode ini untuk Anda.

Cukup pilih rentang sel dan jalankan makro ini.

Sub date2day()

Dim tempCell As Range

Selection.Value = Selection.Value

For Each tempCell In Selection

If IsDate(tempCell) = True Then

With tempCell

.Value = Day(tempCell)

.NumberFormat = "0"

End With

End If

Next tempCell

End Sub

81. Ubah Tanggal menjadi Tahun

Kode ini akan mengkonversi tanggal menjadi tahun.

Sub date2year()

Dim tempCell As Range

Selection.Value = Selection.Value

For Each tempCell In Selection

If IsDate(tempCell) = True Then

With tempCell

.Value = Year(tempCell)

.NumberFormat = "0"

End With

End If

Next tempCell

End Sub

82. Hapus Waktu dari Tanggal

Jika Anda punya waktu dengan tanggal dan ingin menghapusnya maka Anda dapat menggunakan kode ini.

Sub removeTime()

Dim Rng As Range

For Each Rng In Selection

If IsDate(Rng) = True Then

Rng.Value = VBA.Int(Rng.Value)

End If

Next

Selection.NumberFormat = "dd-mmm-yy"

End Sub

83. Hapus Tanggal dari Tanggal dan Waktu

Ini hanya akan mengembalikan waktu dari tanggal dan nilai waktu.

Sub removeDate()

Dim Rng As Range

For Each Rng In Selection

If IsDate(Rng) = True Then

Rng.Value = Rng.Value - VBA.Fix(Rng.Value)

End If

NextSelection.NumberFormat = "hh:mm:ss am/pm"

End Sub

84. Konversikan ke Huruf Besar

Pilih sel dan jalankan kode ini.

Ini akan memeriksa setiap sel dari rentang yang dipilih dan kemudian mengubahnya menjadi teks huruf besar.

Sub convertUpperCase()

Dim Rng As Range

For Each Rng In Selection

If Application.WorksheetFunction.IsText(Rng) Then

Rng.Value = UCase(Rng)

End If

Next

End Sub

85. Konversikan ke Huruf Kecil

Kode ini akan membantu Anda mengubah teks yang dipilih menjadi teks dengan huruf kecil.

Cukup pilih rentang sel tempat Anda memiliki teks dan jalankan kode ini.

Jika sel memiliki angka atau nilai apa pun selain teks nilai itu akan tetap sama.

Sub convertLowerCase()

Dim Rng As Range

For Each Rng In Selection

If Application.WorksheetFunction.IsText(Rng) Then

Rng.Value= LCase(Rng)

End If

Next

End Sub

86. Konversikan ke Kasus yang Tepat

Dan kode ini akan mengubah teks yang dipilih menjadi huruf besar di mana Anda memiliki huruf kapital pertama dan sisanya dalam huruf kecil.

Sub convertProperCase()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsText(Rng) Then

Rng.Value= WorksheetFunction.Proper(Rng.Value)

End If

Next

End Sub

87. Konversikan ke Kasus Kalimat

Dalam kasus teks, Anda memiliki huruf pertama dari kata pertama dalam huruf besar dan sisanya semua dalam kata-kata dalam satu kalimat tunggal dan kode ini akan membantu Anda mengubah teks normal menjadi huruf besar .

Sub convertTextCase()

Dim Rng As Range

For Each Rng In Selection

If WorksheetFunction.IsText(Rng) Then

Rng.Value= UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) -1))

End If

Next rng

End Sub

88. Hapus Karakter dari Pilihan

Untuk menghapus karakter tertentu dari sel yang dipilih, Anda dapat menggunakan kode ini.

Ini akan menampilkan kotak input untuk memasukkan karakter yang ingin Anda hapus.

Sub removeChar()

Dim Rng As Range

Dim rc As String

rc = InputBox("Character(s) to Replace", "Enter Value")

For Each Rng In Selection

Selection.Replace What:=rc, Replacement:=""

Next

End Sub

89. Word Count dari Seluruh Worksheet

Ini dapat membantu Anda menghitung semua kata dari lembar kerja.

Sub Word_Count_Worksheet()

Dim WordCnt As Long

Dim rng As Range

Dim S As String

Dim N As Long

For Each rng In ActiveSheet.UsedRange.Cells

S = Application.WorksheetFunction.Trim(rng.Text)

N = 0

If S <> vbNullString Then

N = Len(S) - Len(Replace(S, " ", "")) + 1

End If

WordCnt = WordCnt + N

Next rng

MsgBox "There are total " & Format(WordCnt, "#,##0") & " words

in the active worksheet"

End Sub

90. Hapus Apostrof dari Angka

Jika Anda memiliki data numerik di mana Anda memiliki tanda kutip sebelum setiap angka, Anda menjalankan kode ini untuk menghapusnya.

Sub removeApostrophes()

Selection.Value = Selection.Value

End Sub

91. Hapus Desimal dari Angka

Kode ini hanya akan membantu Anda menghapus semua desimal dari angka-angka dari rentang yang dipilih.

Sub removeDecimals()

Dim lnumber As Double

Dim lResult As Long

Dim rng As Range

For Each rng In Selection

rng.Value= Int(rng)

rng.NumberFormat= "0"

Next rng

End Sub

92. Gandakan semua Nilai dengan Angka

Mari Anda memiliki daftar angka dan Anda ingin melipatgandakan semua angka dengan angka tertentu.

Cukup gunakan kode ini.

Pilih rentang sel itu dan jalankan kode ini. Pertama-tama Anda akan ditanya nomor yang ingin Anda gandakan dan kemudian gandakan semua nomor dengan itu.

Sub multiplyWithNumber()

Dim rng As Range

Dim c As Integer c = InputBox("Enter number to multiple",

"Input Required")

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value = rng * c

Else

End If

Next rng

End Sub

93. Tambahkan Nomor di semua Angka

Sama seperti mengalikan, Anda juga dapat menambahkan angka ke dalam satu set angka.

Sub addNumber()

Dim rngAs Range

DimiAs Integer

i= InputBox("Enter number to multiple", "Input Required")

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value= rng+ i

Else

End If

Next rng

End Sub

94. Hitung Root Square

Untuk menghitung akar kuadrat tanpa menerapkan rumus, Anda dapat menggunakan kode ini.

Itu hanya akan memeriksa semua sel yang dipilih dan mengkonversi angka ke akar kuadratnya.

Sub getSquareRoot()

Dim rngAs Range

Dim i As Integer

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value= Sqr(rng)

Else

End If

Next rng

End Sub

95. Hitung Root Cube

Untuk menghitung root cube tanpa menerapkan rumus, Anda dapat menggunakan kode ini.

Ini hanya akan memeriksa semua sel yang dipilih dan mengonversi angka ke akar pangkat tiga mereka.

Sub getCubeRoot()

Dim rng As Range

Dimi As Integer

For Each rng In Selection

If WorksheetFunction.IsNumber(rng) Then

rng.Value = rng ^ (1 / 3)

Else

End If

Nextrng

End Sub

96. Tambahkan Abjad AZ dalam Rentang

Sama seperti nomor seri, Anda juga dapat memasukkan huruf di lembar kerja Anda. Di bawah ini adalah kode yang dapat Anda gunakan.

Sub addcAlphabets()

Dim i As Integer

For i= 65 To 90

ActiveCell.Value= Chr(i)

ActiveCell.Offset(1, 0).Select

Next i

End Sub

Sub addsAlphabets()

Dim i As Integer

For i= 97 To 122

ActiveCell.Value= Chr(i)

ActiveCell.Offset(1, 0).Select

Next i

End Sub

97. Ubah Angka Romawi menjadi Angka Arab

Terkadang sangat sulit untuk memahami angka Romawi sebagai nomor seri. Kode ini akan membantu Anda mengubah angka romawi menjadi angka Arab.

Sub convertToNumbers()

Dim rng As Range

Selection.Value= Selection.Value

For Each rng In Selection

If Not WorksheetFunction.IsNonText(rng) Then

rng.Value= WorksheetFunction.Arabic(rng)

End If

Next rng

End Sub

98. Hapus Tanda Negatif

Kode ini hanya akan memeriksa semua sel dalam seleksi dan mengubah semua angka negatif menjadi positif. Cukup pilih rentang dan jalankan kode ini.

Sub removeNegativeSign()

Dim rngAs Range

Selection.Value= Selection.Value

For Each rngIn Selection

If WorksheetFunction.IsNumber(rng)

Then rng.Value= Abs(rng)

End If

Next rng

End Sub

99. Ganti Sel Kosong dengan Nol

Untuk data di mana Anda memiliki sel kosong, Anda dapat menggunakan kode di bawah ini untuk menambahkan nol di semua sel itu. Lebih mudah menggunakan sel-sel itu dalam perhitungan lebih lanjut.

Sub replaceBlankWithZero()

Dim rngAs Range

Selection.Value= Selection.Value

For Each rngIn Selection

If rng= "" Or rng= " " Then

rng.Value= "0"

Else

End If

Next rng

End Sub