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

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


Искам програма, която да намира определено наименование в ексел и щом го намери да нулира стойностите, нанесени на редовете срещу него. Немога да напиша работещ код на VBA. Ще може ли малко помощ!

 

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


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

преди 2 часа, Bbt_sm написа:

 

Искам програма, която да намира определено наименование в ексел и щом го намери да нулира стойностите, нанесени на редовете срещу него. Немога да напиша работещ код на VBA. Ще може ли малко помощ!

 

 

Качи файл с примерни данни в него, за да видим точно какво се иска.

Къде може да са данните, които се търсят и къде може да са данните, които ще се нулират. И какво значи нулиране - да се записва стойност 0, или да се изтриват. 

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


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

Искам например да търси името "СОФИЯ" и стойностите срещу него да са равни на 0

 

KALDATA.xlsx

Редактирано от Bbt_sm (преглед на промените)

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


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

С този цикъл ми намира всички съвпадения, но незнам как да нулирам стойностите срещу тях или поне да изтрия самия ред с този запис

 

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
  fnd = "СОФИЯ"

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
    
      Set rng = Union(rng, FoundCell)
    
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop


  rng.Select
  
Exit Sub


NothingFound:
  MsgBox "No values were found in this worksheet"
 

Редактирано от Bbt_sm (преглед на промените)

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


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

Не съм гледал какво е направено, направих си моя процедура

Const SearchColumn = "C" ' Това е колоната в която се търсят данните
Const NaRow = 1 ' Това е № на реда от който започват данните
Const MyOffset = 2 'Това е след колко колони да започне нулирането на данните, понеже видждам, че данните са една колона след 'C'

' 1 - данните се нулират веднага след колона C - от колона D, 2 - данните се нулират от колона E

'OpiNull е как се извиква функцията
Sub OpiNull()
 Call NullData("София")
End Sub
Sub NullData(WhoSearch As String)
 Dim DataSearch As Range
 Dim Rng As Range
 Dim LastRow As Long
 Dim LastColumn As Long
 Dim ChangeData As Range
 LastRow = LastRowInOneColumn(SearchColumn)
 If LastRow < NaRow Then Exit Sub
 Set DataSearch = Range(SearchColumn & NaRow & ":" & SearchColumn & LastRow)
 For Each Rng In DataSearch
  If UCase(Rng.Value) Like "*" & UCase(WhoSearch) & "*" Then
   LastColumn = LastColumnInOneRow(Rng.Row)
   If LastColumn > NaRow Then
    Rng.Offset(, MyOffset).Resize(1, LastColumn - Rng.Column - MyOffset + 1).Value = 0
   End If
  End If
 Next
End Sub

'това са функции за намиране на последната колона или ред с данни
Function LastRowInOneColumn(NameColumn As String) As Long
 LastRowInOneColumn = Cells(Rows.Count, NameColumn).End(xlUp).Row
End Function

Function LastColumnInOneRow(NumberRow As Long) As Long
 LastColumnInOneRow = Cells(NumberRow, Columns.Count).End(xlToLeft).Column
End Function


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


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

Не съм гледал какво е направено, направих си моя процедура

Const SearchColumn = "C" ' Това е колоната в която се търсят данните
Const NaRow = 1 ' Това е № на реда от който започват данните
Const MyOffset = 2 'Това е след колко колони да започне нулирането на данните, понеже видждам, че данните са една колона след 'C'

' 1 - данните се нулират веднага след колона C - от колона D, 2 - данните се нулират от колона E

'OpiNull е как се извиква функцията
Sub OpiNull()
 Call NullData("София")
End Sub
Sub NullData(WhoSearch As String)
 Dim DataSearch As Range
 Dim Rng As Range
 Dim LastRow As Long
 Dim LastColumn As Long
 Dim ChangeData As Range
 LastRow = LastRowInOneColumn(SearchColumn)
 If LastRow < NaRow Then Exit Sub
 Set DataSearch = Range(SearchColumn & NaRow & ":" & SearchColumn & LastRow)
 For Each Rng In DataSearch
  If UCase(Rng.Value) Like "*" & UCase(WhoSearch) & "*" Then
   LastColumn = LastColumnInOneRow(Rng.Row)
   If LastColumn > NaRow Then
    Rng.Offset(, MyOffset).Resize(1, LastColumn - Rng.Column - MyOffset + 1).Value = 0
   End If
  End If
 Next
End Sub

'това са функции за намиране на последната колона или ред с данни
Function LastRowInOneColumn(NameColumn As String) As Long
 LastRowInOneColumn = Cells(Rows.Count, NameColumn).End(xlUp).Row
End Function

Function LastColumnInOneRow(NumberRow As Long) As Long
 LastColumnInOneRow = Cells(NumberRow, Columns.Count).End(xlToLeft).Column
End Function

Уауууу! Благодаря за положения труд!

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


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

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

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

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

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

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

Вход

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

Вход

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

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

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

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

    • от Bbt_sm
      Мога ли да присвоя няколко стойности на една променлива. Т.е искам в екселски файл, да се търсят няколко стойности едновременно, например find = "Пловдив", "София,"Варна" , но възможно ли е икак се пише на 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
    • от Yehet
      Как да намеря дали броят на повторенията на всички символи от стринг са равни? Например за стринга "aaddff" ще покаже да, а за стринга "аddff" не.
    • от Mladen Petkov
      Добър ден , искам да помоля за презентация под формата на  тест с 3 - 4 въпроса в която да има макроси , label и text box.Да не е нещо  , кой знае колко сложно.Благодаря предварително . 
       
      П.С - Ако темата не е на правилното място се извинявам за това и моля да бъде преместена
    • от venezS
      Здравейте,
      моля за помощ . търсих в нета , но не можах да намеря отговор. 
      След като проверих написаният макрос в Опън Офиса и и минава без синтактични грешки на края ми излиза надпис:
      И не мига да разбера къде е проблема.
       
      BASIC syntax error. Unexpected symbol: Еnd sub.
      ">http://
       
      Нали всички кодове трябва да завършват с Еnd sub.
      Другите ми макроси сработват , но за този ми дава тази грешка,  Къде да търся причината ..
      Предварително благодаря на всеки който желае да ми помогне.
      Лека и приятна вечер !
  • Дарение

×

Информация

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