Премини към съдържанието

Препоръчан отговор


Мога ли да присвоя няколко стойности на една променлива. Т.е искам в екселски файл, да се търсят няколко стойности едновременно, например find = "Пловдив", "София,"Варна" , но възможно ли е икак се пише на VBA

Сподели този отговор


Линк към този отговор
Сподели в други сайтове

На една променлива може да се присвоява една стойност. За работа с повече данни се използват масиви.

А по въпроса на търсенето, въпроса не е зададен правилно.

Как да се търсят данните. Данните, които се търсят къде да са разположени, само в една клетка или може в различни клетки да има различни данни, и не на последно място какви ще са действията с намерените съвпадения. Просто се чудя как да опиша ситуацията.

С подобни откъслечни питания няма как да се даде отговор.

 

  • Харесва ми 1

Сподели този отговор


Линк към този отговор
Сподели в други сайтове

Търсенето е в отделни клетки, а кокогато се намерят съвпадения ще се триият. Това е кода за търсене на една дума, а аз искам за няколко едновременно.

 

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, Rng As Range
Dim myRange As Range, LastCell As Range
Dim xRows As Long
Dim xCol As Long
Dim colorLg As Long
On Error Resume Next

'What value do you want to find (must be in string form)?
  fnd = "СОФИЯ"
  'fnd = InputBox("I want to hightlight cells containing...", "Highlight")

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(What:=fnd, After:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set Rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(After:=FoundCell)
    
    'Add found cell to rng range variable
      Set Rng = Union(Rng, FoundCell)
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Select Cells Containing Find Value
  Rows(ActiveCell.Row).Select
  Rng.Select
  Rng.Interior.Color = RGB(255, 255, 0)
  
  MsgBox Rng.Cells.Count & " cell(s) were found containing: " & fnd
  
    
    colorLg = RGB(255, 255, 0)
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For xRows = .Rows.Count To 1 Step -1
            For xCol = 1 To .Columns.Count
                           If .Cells(xRows, xCol).Interior.Color = colorLg Then
                    .Rows(xRows).delete
                    Exit For
                End If
            Next xCol
        Next xRows
    End With
    Application.ScreenUpdating = True
Exit Sub


'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"

Сподели този отговор


Линк към този отговор
Сподели в други сайтове

Find не поддържа такъв вид търсене.

Направи го в процедура за търсене и изтриване с входен параметър какво се търси, и за всеки елемент, който искаш да се търси извиквай процедурата.

Това е скелета на процедурата

Sub SearchAndDel(fnd As String)

 'тук сложи твоя код, като махнеш fnd As String от декларациите, защото ще се повтаря

end sub

А извикването ще става

Call SearchAndDel("София")

Call SearchAndDel("Пловдив")

и т.н.

 

Друг вариант може да бъде така - процедурата само да оцветява клетките и след всички видове търсения да се трият данните

 

Редактирано от TRN (преглед на промените)
  • Харесва ми 1

Сподели този отговор


Линк към този отговор
Сподели в други сайтове

Предполагам, че това е вариант от другите дискусии

Аз лично бих го направил по друг начин. Използвайки променливи, които са зададени там, например така

'Процедура за извикване 

Sub OpiDelChoicesRow()
 Call DelChoicesRow("София|пловдив") ' това | е разделител между данните, които ще се търсят 
End Sub

'Процедура за търсене и изтриване на редовете
Sub DelChoicesRow(SearchData As String)
 Dim MyArr As Variant
 Dim I As Integer
 Dim DataSearch As Range
 Dim Rng As Range, MyRange As Range
 Dim LastRow As Long
 Dim Mask As Boolean
 LastRow = LastRowInOneColumn(SearchColumn)
 If LastRow < NaRow Then Exit Sub
 If Len(SearchData) < 1 Then Exit Sub
 MyArr = Split(SearchData, "|") ' | същия разделител, може да бъде всякакъв символ, но да не се среща някъде в данните, които ще се търсят
 Set DataSearch = Range(SearchColumn & NaRow & ":" & SearchColumn & LastRow)
 For Each Rng In DataSearch
  Mask = False
  For I = LBound(MyArr) To UBound(MyArr)
   Mask = Mask Or UCase(Rng.Value) Like "*" & UCase(MyArr(I)) & "*"
   If Mask Then Exit For
  Next
  If Mask Then
   If MyRange Is Nothing Then
    Set MyRange = Range(Rng.Row & ":" & Rng.Row)
   Else
    Set MyRange = Application.Union(MyRange, Range(Rng.Row & ":" & Rng.Row))
   End If
  End If
 Next
 If MyRange Is Nothing Then
 Else
  MyRange.Delete Shift:=xlUp
 End If
End Sub

 


Сподели този отговор


Линк към този отговор
Сподели в други сайтове
преди 17 часа, TRN написа:

Find не поддържа такъв вид търсене.

Направи го в процедура за търсене и изтриване с входен параметър какво се търси, и за всеки елемент, който искаш да се търси извиквай процедурата.

Това е скелета на процедурата

Sub SearchAndDel(fnd As String)

 'тук сложи твоя код, като махнеш fnd As String от декларациите, защото ще се повтаря

end sub

А извикването ще става

Call SearchAndDel("София")

Call SearchAndDel("Пловдив")

и т.н.

 

Друг вариант може да бъде така - процедурата само да оцветява клетките и след всички видове търсения да се трият данните

 

Така стана! Мноооооооого благодаря!

Сподели този отговор


Линк към този отговор
Сподели в други сайтове

Регистрирайте се или влезете в профила си за да коментирате

Трябва да имате регистрация за да може да коментирате това

Регистрирайте се

Създайте нова регистрация в нашия форум. Лесно е!

Нова регистрация

Вход

Имате регистрация? Влезте от тук.

Вход

  • Разглеждащи това в момента   0 потребители

    Няма регистрирани потребители разглеждащи тази страница.

  • Горещи теми в момента

  • Подобни теми

    • от Bbt_sm
      Искам програма, която да намира определено наименование в ексел и щом го намери да нулира стойностите, нанесени на редовете срещу него. Немога да напиша работещ код на VBA. Ще може ли малко помощ!
       
    • от Bbt_sm
      Имам 4 колони и искам колона D да се сравява с колона M, а колона E да се сравнява с колона N И ако има еднакви числа да се нулират и всичко да се случва с едно кликане на бутонче в Excel,  но немога да обединя кода. Този със сигурност не работи, по отделно работят но незнам как да ги обединя в едно. Бихте ли ми помогнали?
       
      Dim x As Range, y As Range, z As Range, q As Range, de As Range
      Set x = Range("D1:D20")
      Set y = Range("N1:N20")
      Set q = Range("E1:E20")
      Set z = Range("M1:M20")
      Set de = Range("D1:E20")
      de.Select
      For Each x In Range("D1:D20")
          For Each y In Range("N1:N20")
              For Each z In Range("E1:E20")
                  For Each q In Range("M1:M20")
              If x.Value = y.Value Then
                  x.Value = 0
                  y.Value = 0
              End If
              
               If z.Value = q.Value Then
                  z.Value = 0
                  q.Value = 0
              End If
              
                  Next q
              Next z
          Next y
      Next x
    • от Mladen Petkov
      Добър ден , искам да помоля за презентация под формата на  тест с 3 - 4 въпроса в която да има макроси , label и text box.Да не е нещо  , кой знае колко сложно.Благодаря предварително . 
       
      П.С - Ако темата не е на правилното място се извинявам за това и моля да бъде преместена
    • от venezS
      Здравейте,
      моля за помощ . търсих в нета , но не можах да намеря отговор. 
      След като проверих написаният макрос в Опън Офиса и и минава без синтактични грешки на края ми излиза надпис:
      И не мига да разбера къде е проблема.
       
      BASIC syntax error. Unexpected symbol: Еnd sub.
      ">http://
       
      Нали всички кодове трябва да завършват с Еnd sub.
      Другите ми макроси сработват , но за този ми дава тази грешка,  Къде да търся причината ..
      Предварително благодаря на всеки който желае да ми помогне.
      Лека и приятна вечер !
  • Дарение

×

Информация

Поставихме бисквитки на устройството ви за най-добро потребителско изживяване. Можете да промените настройките си за бисквитки, или в противен случай приемаме, че сте съгласни с нашите условия за ползване.