ВБА примери - Списак 19 најбољих Екцел ВБА примера за почетнике

Екцел ВБА примери за почетнике

Макронаредбе су ваш најбољи пријатељ када је реч о повећању ваше продуктивности или уштеди времена на вашем радном месту. Од малих до великих задатака, можемо аутоматизовати помоћу језика кодирања ВБА. Знам да сте често помислили на нека ограничења која Екцел има, али помоћу ВБА кодирања можете све то уклонити. Ок, ако сте се борили са ВБА и још увек сте почетник у овом чланку, даћемо неке корисне примере ВБА макро кода у програму Екцел.

Листа најбољих 19 примера

  1. Одштампајте сва имена листова
  2. Уметните другачији индекс боја у ВБА
  3. Уметните серијски број од врха
  4. Уметните серијски број одоздо
  5. Уметните серијски број од 10 до 1
  6. Уметните радне листове колико год желите
  7. Избришите све празне радне листове из радне свеске
  8. Уметни празан ред након сваког другог реда
  9. Истакните правописну грешку
  10. Промените све великим словима
  11. Промените све у мала слова
  12. Означите све коментарисане ћелије
  13. Означите Све празне ћелије
  14. Сакриј све табеле осим једног листа
  15. Откриј све табеле
  16. Избришите све датотеке у фасцикли
  17. Избриши целу фасциклу
  18. Пронађите последњи коришћени ред у табели
  19. Пронађите последњу коришћену колону у листу

Погледајмо сваки од ових примера детаљно.

# 1 - Одштампајте имена свих листова

Шифра:

Суб Принт_Схеет_Намес () Дим и ас Интегер фор и = 1 То Схеетс.Цоунт Целлс (и, 1) .Валуе = Схеетс (и) .Наме Нект и Енд Суб

Ово ће издвојити сва имена листова у активни лист.

# 2 - Уметните другачији индекс боја у ВБА

Шифра:

Суб Инсерт_Дифферент_Цолоурс () Дим и Ас Интегер фор и = 1 То 56 Целлс (и, 1) .Валуе = и Целлс (и, 2) .Интериор.ЦолорИндек = и Нект Енд Суб

Ово ће уметнути бројеве од 1 до 56 и њихов индекс боја у следећу колону.

# 3 - Уметните серијски број одозго

Шифра:

Суб Инсерт_Нумберс_Фром_Топ () Дим и Ас Интегер фор и = 1 То 10 Целлс (и, 1) .Валуе = и Нект и Енд Суб

Ово ће уметнути серијске бројеве од 1 до 10 одозго.

# 4 - Уметните серијски број одоздо

Шифра:

Суб Инсерт_Нумберс_Фром_Боттом () Дим и ас Интегер фор и = 20 то 1 Степ -1 Целлс (и, 7) .Валуе = и Нект и Енд Суб

Ово ће уметнути серијске бројеве од 1 до 20 одоздо.

# 5 - Уметните серијски број од 10 до 1

Шифра:

Суб Тен_То_Оне () Дим и Ас Интегер Дим ј Ас Интегер ј = 10 Фор и = 1 то 10 Ранге ("А" & и) .Валуе = јј = ј - 1 Нект и Енд Суб

Ово ће уметнути серијске бројеве од 10 до 1 од врха.

# 6 - Уметните радне листове колико год желите

Шифра:

Суб АддСхеетс () Дим СхтЦоунт као цео број, и као цео број СхтЦоунт = Апплицатион.ИнпутБок ("Колико листова желите да уметнете?", "Додај листове",,,,,, 1) Ако је СхтЦоунт = Фалсе, онда изађите из Суб Елсе За и = 1 на радне листове СхтЦоунт.Додај Следеће и Енд Иф Енд Суб

Затражиће се да унесете број радних листова које желите да уметнете. Само наведите број у пољу за унос и кликните на Ок, он ће одмах уметнути толико листова.

# 7 - Из радне свеске избришите све празне радне листове

Шифра:

Под Делете_Бланк_Схеетс () Дим вс ас Ворксхеет Апплицатион.ДисплаиАлертс = Фалсе Апплицатион.СцреенУпдатинг = Фалсе Фор еацх вс ин АцтивеВоркбоок.Ворксхеетс Иф ВорксхеетФунцтион.ЦоунтА (вс.УседРанге) = 0 Затим вс.Делете Енд Иф Нект вс Апплицатион.ДисплаиАлертс = .СцреенУпдатинг = Потпуни крај

This will delete all the blank worksheets from the workbook we are working on.

#8 - Insert Blank Row After Every Other Row

Code:

Sub Insert_Row_After_Every_Other_Row() Dim rng As Range Dim CountRow As Integer Dim i As Integer Set rng = Selection CountRow = rng.EntireRow.Count For i = 1 To CountRow ActiveCell.EntireRow.Insert ActiveCell.Offset(2, 0).Select Next i End Sub

For this first, you need to select the range where you would like to insert alternative blank rows.

#9 - Highlight Spelling Mistake

Code:

Sub Chech_Spelling_Mistake() Dim MySelection As Range For Each MySelection In ActiveSheet.UsedRange If Not Application.CheckSpelling(Word:=MySelection.Text) Then MySelection.Interior.Color = vbRed End If Next MySelection End Sub

First, select the data and run the VBA code. It will highlight the cells which have spelling mistakes.

#10 - Change All To Upper Case Characters

Code:

Sub Change_All_To_UPPER_Case() Dim Rng As Range For Each Rng In Selection.Cells If Rng.HasFormula = False Then Rng.Value = UCase(Rng.Value) End If Next Rng End Sub

First, select the data and run the code. It will convert all the text values to upper case characters.

#11 - Change All To Lower Case Characters

Code:

Sub Change_All_To_LOWER_Case() Dim Rng As Range For Each Rng In Selection.Cells If Rng.HasFormula = False Then Rng.Value = LCase(Rng.Value) End If Next Rng End Sub

First, select the data and run the code. It will convert all the text values to lower case characters in excel.

#12 - Highlight All the Commented Cells

Code:

Sub HighlightCellsWithCommentsInActiveWorksheet() ActiveSheet.UsedRange.SpecialCells(xlCellTypeComments).Interior.ColorIndex = 4 End Sub

Result:

#13 - Highlight All the Blank Cells

Code:

Sub Highlight_Blank_Cells() Dim DataSet As Range Set DataSet = Selection DataSet.Cells.SpecialCells(xlCellTypeBlanks).Interior.Color = vbGreen End Sub

First, select the data range and run the code. It will highlight all the blank cells with green color.

#14 - Hide All Sheets Except One Sheet

Code:

Sub Hide_All_Except_One() Dim Ws As Worksheet For Each Ws In ActiveWorkbook.Worksheets If Ws.Name "Main Sheet" Then Ws.Visible = xlSheetVeryHidden Next Ws End Sub

The above code hides all the sheets except the sheet named “Main Sheet.” You can change the worksheet name as per your wish.

#15 - Unhide All Sheets

Code:

Sub UnHide_All() Dim Ws As Worksheet For Each Ws In ActiveWorkbook.Worksheets Ws.Visible = xlSheetVisible Next Ws End Sub

This will unhide all the hidden sheets.

#16 - Delete All Files in the Folder

Code:

Sub Delete_All_Files() 'You can use this to delete all the files in the folder Test '' On Error Resume Next Kill "C:UsersAdmin_2.Dell-PcDesktopDelete Folder*.*" On Error GoTo 0 End Sub

Change the folder path, which is marked in red as per your folder deletion.

#17 - Delete Entire Folder

Code:

Sub Delete_Whole_Folder() 'You can use this to delete entire folder On Error Resume Next Kill "C:UsersAdmin_2.Dell-PcDesktopDelete Folder*.*" 'Firstly it will delete all the files in the folder 'Then below code will delete the entire folder if it is empty RmDir "C:UsersAdmin_2.Dell-PcDesktopDelete Folder " 'Note: RmDir delete only a empty folder On Error GoTo 0 End Sub

Change the folder path, which is marked in red as per your folder deletion.

#18 - Find the Last Used Row in the Sheet

Code:

Суб Ласт_Ров () Дим ЛР ас Лонг ЛР = Целлс (Ровс.Цоунт, 1) .Енд (клУп) .Ров МсгБок ЛР Енд Суб

Овде проналазимо последњи коришћени ред у табели

# 19 - Пронађите последњу коришћену колону у листу

Шифра:

Суб Ласт_Цолумн () Дим ЛЦ Ас Лонг ЛЦ = Целлс (1, Цолумнс.Цоунт) .Енд (клТоЛефт) .Цолумн МсгБок ЛЦ Енд Суб

Овде проналазимо последњу коришћену колону у листу

Занимљиви Чланци...