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

 

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

 

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

 

 

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

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

преди 25 минути, TRN написа:

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

 

KALDATA.xlsx

Редактирано 22 май 20179 г. от 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"
 

Редактирано 22 май 20179 г. от 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

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