Избавьтесь от повторяющегося кода (процедура слишком большая ошибка) - PullRequest
0 голосов
/ 24 июня 2019

Я хочу избавиться от этих больших блоков повторяющегося кода, используя «For Each» или любой другой полезный подход

У меня только блоки кода повторяются около 70 раз, но так как он содержит несколько динамических значений, мне трудно использовать «For Each»

Public Sub ToTextBox()
Dim wsA As Worksheet
Set wsA = Sheets("Compute")

'1
With Sheets("Slide Data").Shapes("TextBox 1")
    .TextFrame.Characters.Text = wsA.Range("b" & Range("L2")).Value & Chr(10) & wsA.Range("c" & Range("L2")).Value
    .TextFrame.Characters(1, 7).Font.Bold = True
    .TextFrame.Characters(1, 7).Font.Size = 7
    .TextFrame.Characters(1, 7).Font.Name = "Verdana"
    .TextFrame.HorizontalAlignment = xlHAlignCenter
End With

    Sheets("Slide Data").Shapes("TextBox 1A").TextFrame.Characters.Text = Sheet3.Range("a" & Range("L2")).Value
    Sheets("Slide Data").Shapes("TextBox 1B").TextFrame.Characters.Text = Sheet3.Range("k" & Range("L2")).Value
    Sheets("Slide Data").Shapes("TextBox 1C").TextFrame.Characters.Text = Sheet3.Range("j" & Range("L2")).Value

'2   
With Sheets("Slide Data").Shapes("TextBox 2")
    .TextFrame.Characters.Text = wsA.Range("b" & Range("L2") + 1).Value & Chr(10) & wsA.Range("c" & Range("L2") + 1).Value
    .TextFrame.Characters(1, 7).Font.Bold = True
    .TextFrame.Characters(1, 7).Font.Size = 7
    .TextFrame.Characters(1, 7).Font.Name = "Verdana"
    .TextFrame.HorizontalAlignment = xlHAlignCenter
End With

    Sheets("Slide Data").Shapes("TextBox 2A").TextFrame.Characters.Text = Sheet3.Range("a" & Range("L2") + 1).Value
    Sheets("Slide Data").Shapes("TextBox 2B").TextFrame.Characters.Text = Sheet3.Range("k" & Range("L2") + 1).Value
    Sheets("Slide Data").Shapes("TextBox 2C").TextFrame.Characters.Text = Sheet3.Range("j" & Range("L2") + 1).Value

'3    
With Sheets("Slide Data").Shapes("TextBox 3")
    .TextFrame.Characters.Text = wsA.Range("b" & Range("L2") + 2).Value & Chr(10) & wsA.Range("c" & Range("L2") + 2).Value
    .TextFrame.Characters(1, 7).Font.Bold = True
    .TextFrame.Characters(1, 7).Font.Size = 7
    .TextFrame.Characters(1, 7).Font.Name = "Verdana"
    .TextFrame.HorizontalAlignment = xlHAlignCenter
End With

    Sheets("Slide Data").Shapes("TextBox 3A").TextFrame.Characters.Text = Sheet3.Range("a" & Range("L2") + 2).Value
    Sheets("Slide Data").Shapes("TextBox 3B").TextFrame.Characters.Text = Sheet3.Range("k" & Range("L2") + 2).Value
    Sheets("Slide Data").Shapes("TextBox 3C").TextFrame.Characters.Text = Sheet3.Range("j" & Range("L2") + 2).Value

'and 72 others


End Sub

Ищем циклический подход для сжатия этого кода

1 Ответ

0 голосов
/ 24 июня 2019

Включите это:

With Sheets("Slide Data").Shapes("TextBox 1")
    .TextFrame.Characters.Text = wsA.Range("b" & Range("L2")).Value & Chr(10) & wsA.Range("c" & Range("L2")).Value
    .TextFrame.Characters(1, 7).Font.Bold = True
    .TextFrame.Characters(1, 7).Font.Size = 7
    .TextFrame.Characters(1, 7).Font.Name = "Verdana"
    .TextFrame.HorizontalAlignment = xlHAlignCenter
End With

В это:

Sub ShapeStuff(number as Long, sourceSheet as Worksheet)
    With Sheets("Slide Data").Shapes("TextBox " & cstr(number))
        .TextFrame.Characters.Text = sourceSheet.Range("b" & sourceSheet.Range("L2") + number - 1).Value & Chr(10) & sourceSheet.Range("c" & Range("L2") + number - 1).Value
        .TextFrame.Characters(1, 7).Font.Bold = True
        .TextFrame.Characters(1, 7).Font.Size = 7
        .TextFrame.Characters(1, 7).Font.Name = "Verdana"
        .TextFrame.HorizontalAlignment = xlHAlignCenter
    End With
End Sub

Затем позвоните ShapeStuff(1, wsA), ShapeStuff(2, wsA) и ShapeStuff(3, wsA) вместо

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...