Новости:

Форум на данный момент в стадии обновления. Если у Вас возникли проблемы со входом в свою учетную запись - просьба писать на email: info@excel-vba.ru

Главное меню

Макрос очистки ячеек по условию

Автор nadegda, 03.07.2013, 12:27:53

« назад - далее »

Дмитрий Щербаков(The_Prist)

#45
Цитата: nadegda от 05.07.2013, 17:39:27
не понимаю Вашего саркзма, я просто не сталкивалась с подобными вещами еще
Это не сарказм - это элементарные азы. Если пишите макросы, то уж вызывать их точно должны уметь: Что такое макрос и где его искать?
О каких подобных вещах речь? О макросах в целом? Тогда советую весь раздел "Что умеет Excel" прочитать. Хотя бы первый раздел. Если о RegExp - то к вызову макроса он отношения не имеет...

Изначально Ваш вопрос был описан как приведению к нулю чисел в формулах. Я дал код. Теперь оказалось, что коды Вы применять не умеете. Я откуда это могу знать, Вы изначально повели себя как человек знающий(готовый код Вам был не нужен). Я и решил, что уж методы вызова макросов Вам точно известны. Знал бы, что Вы в кодах практически не понимаете - расписал бы инструкцию и дал необходимые ссылки, выложил бы сразу файл, вместо того, чтобы думать, что Вы понимаете как прочитать код и что с ним делать. Ведь в моем коде все элементарно кроме регулярных выражений. Никаких других "изысков" там нет и человек, умеющий писать коды смог бы понять, что для работы кода необходимо выделять ячейки для обработки. За это отвечает строка For Each rCell In Selection(начало цикла по выделенным ячейкам). И это действительно азы программирования в VBA.
А Вы и мой код игнорировали, уверяя, что не работает(но не указывая, что конкретно не работает и в чем неработа выражается), пока я Вам не выложил файл. Да и файл-то Вы забраковали...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

nadegda

Я ни в коем случае не браковала ваш код и уж тем более файл. Я не позиционировала себя как знающий человек, еще в первом сообщении написав, что это новая область для меня,но прийти и сказать "дайте мне готовый код" это уж слишком
в любом случае, Вы потратили много времени
Спасибо Вам

nadegda

'Äëÿ ïåðåõîäà ïî ëèñòàì
Sub Perehod()
Dim SkrBook As String 'èìÿ êíèãè ñî ñêðèïòîì
Dim ListName As String 'èìÿ ëèñòà î÷èñòêè
Dim FileBujet As String 'èìÿ êíèãè ñ áþäæåòîì
Dim fstr As String
Dim KeyCode As Integer
Dim i As Integer
Dim j As Integer
Dim Array_Keys As Variant
SkrBook = ActiveWorkbook.Name
listNum = Workbooks(SkrBook).Worksheets("áþäæåò").Range("A1").CurrentRegion.Rows.Count
MsgBox ("Îòêðîéòå, ïîæàëóéñòà, ôàéë áþäæåòà äëÿ î÷èñòêè")
File = Application.GetOpenFilename(" MS Excel (*.xlsx), *.xlsx")
Workbooks.Open File, UpdateLinks:=0
FileBujet = ActiveWorkbook.Name
Column = Array(8, 10, 15)
Countcolumn = ubount(Column)


Array_Keys = Array("=", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "-", "/", "*", "(", ")", "%", ",")

For lst = 2 To listNum

    Workbooks(SkrBook).Worksheets("áþäæåò").Activate
    ListName = Workbooks(SkrBook).Worksheets("áþäæåò").Cells(lst, 1).Value
    Workbooks(FileBujet).Worksheets(ListName).Activate
   
'òåïåðü çàïèøåì  öèêë äëÿ ñèòóàöèè 2
    For Stroka = 11 To Workbooks(SkrBook).Worksheets("áþäæåò").Cells(lst, 2).Value
    For i = 0 To Countcolumn
    For j = 1 To 999
   
    Cells(j, Column(i)) = Rep2(Cells(j, Column(i)).Formula)
    Next i
    Next j
   
        'If Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 10).HasFormula = False Then
           ' Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 10).Value = ""
       ' Else
           'flag = 0
           ' fstr = Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 10).Formula
           
           ' For s = 1 To Len(fstr)
               
               ' For i = 1 To 19
               
                    'If Mid(fstr, s, 1) = Array_Keys(i) Then
                        'flag = flag + 1
                                               
                    'End If
               ' Next i
               
            'Next s
           
           ' If flag = Len(fstr) Then
                'Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 10).Value = ""
            'End If

        'End If
   
   'Next stroka
   
   
  ' For stroka = 11 To Workbooks(SkrBook).Worksheets("áþäæåò").Cells(lst, 2).Value
   
        'If Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 9).HasFormula = False Then
            'Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 9).Value = ""
        'Else
            'flag = 0
            'fstr = Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 8).Formula
           
            'For s = 1 To Len(fstr)
               
                'For i = 1 To 19
               
                    'If Mid(fstr, s, 1) = Array_Keys(i) Then
                        'flag = flag + 1
                                               
                    'End If
                'Next i
               
           ' Next s
           
            'If flag = Len(fstr) Then
               ' Workbooks(FileBujet).Worksheets(ListName).Cells(stroka, 8).Value = ""
            'End If

        'End If
   
   Next Stroka
   
   For Stroka = 11 To Workbooks(SkrBook).Worksheets("áþäæåò").Cells(lst, 2).Value
        If Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).HasFormula = False Then
            Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).Value = ""
        Else
            flag = 0
            fstr = Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).Formula
           
            For s = 1 To Len(fstr)
               
                For i = 1 To 19
               
                    If Mid(fstr, s, 1) = Array_Keys(i) Then
                        flag = flag + 1
                                               
                    End If
                Next i
               
            Next s
           
            If flag = Len(fstr) Then
                Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).Value = ""
            End If

        End If
   
   Next Stroka
   

   


Next lst



End Function



Sub aaa()

Column = Array(8, 10, 15)
Countcolumn = UBound(Column)
Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).Value = Rep2(Workbooks(FileBujet).Worksheets(ListName).Cells(Stroka, 15).Formula)
    For i = 0 To Countcolumn
    For j = 1 To 999
   
    Cells(j, Column(i)) = Rep2(Cells(j, Column(i)).Formula)
    Next i
   
    Next j
   



Function Rep2(fstr As String)
Dim fstr2 As String, buf As String
Dim flag, flag2 As Boolean




If (Mid(fstr, 1, 1) = "=") Then
    buf = buf + "="
    For i = 2 To Len(fstr)
        flag = False
        fstr2 = Mid(fstr, i, 1)
        If (Asc(fstr2) > 47) And (Asc(fstr2) < 59) Then
            fstr3 = Mid(fstr, i - 1, 1)
            If (fstr3 = "" Or fstr3 = "+" Or fstr3 = "-" Or fstr3 = "=" Or fstr3 = "/" Or fstr3 = "*" Or fstr3 = "(") Then
            'Symvol=Asc(fstr3)
            'If (( Symvol<65) Or ( Symvol>90) And (( Symvol<191) Or ( Symvol>224) And (( Symvol<48) Or ( Symvol>58) And (( Symvol<>48) Then
                flag2 = False
                If (fstr3 = "(") Then
                   fstr4 = Mid(fstr, i - 2, 1)
                   If ((Asc(fstr4) > 64) And (Asc(fstr4) < 91) Or (Asc(fstr4) > 191) And (Asc(fstr4) < 224)) Then
                   flag2 = True
                    End If
                End If
               
               
                If flag2 = False Then
                    For j = i + 1 To Len(fstr)
                        flag = True
                        fstr3 = Mid(fstr, j, 1)
                        If ((Asc(fstr3) < 48) Or (Asc(fstr3) > 58) Or j = Len(fstr)) Then
                        buf = buf + "0"
                        If (j = Len(fstr)) Then
                            i = j - 1
                       
                        Else
                            i = j - 1
                        End If
                        Exit For
                    End If
                Next j
               End If
            End If
        End If
    If flag = False Then
    buf = buf + fstr2
    End If
    Next i
    End If
    Rep2 = buf
    End Function
   

End Sub














Юрий М

1. Оформляйте код соответствующим тегом.
2. Если код большой - прячьте его под спойлер.
3. Копируйте код при русской раскладке клавиатуры.
4. Кучу пустых строк показывать совсем необязательно...

ShAM


Дмитрий Щербаков(The_Prist)

А это вообще работает? Ошибку компиляции сей код не выдает? потому как почему-то у Вас функция "Rep2" внутри процедуры "ааа". Такое не будет работать.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Яндекс.Метрика Рейтинг@Mail.ru