Как я могу изменить свой код, чтобы он работал быстрее?

В методе render () вы можете использовать inline If :

{this.state.articles && (
  // Display articles
)}

Когда articles перестает быть нулевым, элемент сразу после & amp; & amp; & amp; будет отображаться, и пока он равен нулю, ошибки не будут выбрасываться.

1
задан Pᴇʜ 21 January 2019 в 07:45
поделиться

3 ответа

Move Rows

Союзная версия

Option Explicit

Sub Move()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Dim rngU As Range, r As Long, lastrow2 As Long, lastrow As Long

    On Error GoTo ProcedureExit

    With Worksheets("From Taxwise")
        lastrow = .Cells(.Rows.Count, "L").End(xlUp).row
        For r = 2 To lastrow
            If Not .Range("L" & r).Value = "US" Then
                If Not rngU Is Nothing Then
                    Set rngU = Union(rngU, .Cells(r, 1))
                  Else
                    Set rngU = .Cells(r, 1)
                End If
            End If
        Next
    End With

    If Not rngU Is Nothing Then
        With Worksheets("State")
            lastrow2 = .Cells(.Rows.Count, "L").End(xlUp).row
            rngU.EntireRow.Copy .Range("A" & lastrow2 + 1)
            rngU.EntireRow.Delete
        End With
        Set rngU = Nothing
    End If

ProcedureExit:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
0
ответ дан VBasic2008 21 January 2019 в 07:45
поделиться

Этот код занял около двух секунд, чтобы запустить 150000 записей с примерно 3000, равными США.

Вам нужно будет изменить его в соответствии с вашими настройками. например: названия различных рабочих листов; диапазоны ячеек, если ваши таблицы не начинаются с A1, немного другой синтаксис, если ваши данные в Excel Tables, а не просто диапазоны и т. д.

Используется встроенный автофильтр Excel [ 1111]

В листе назначения есть все строки, кроме тех, которые имеют США.

Option Explicit
Sub noUS()
    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rSrc As Range, rDest As Range
    Const filterColumn As Long = 4 'Change to 12 for column L
    Dim LRC() As Long

Set wsSrc = Worksheets("sheet1")
Set wsDest = Worksheets("sheet2")
    Set rDest = wsDest.Cells(1, 1)
    wsDest.Cells.Clear

With wsSrc
'get last row and column of the source worksheet
    LRC = LastRowCol(.Name)

'set the range
    Set rSrc = .Range(.Cells(1, 1), .Cells(LRC(0), LRC(1)))

'set the filter
  'first turn it off
  .AutoFilterMode = False

  'now set it for the range
  rSrc.AutoFilter _
    field:=filterColumn, _
    Criteria1:="<>US", _
    visibledropdown:=False

  End With

  Set rSrc = rSrc.SpecialCells(xlCellTypeVisible)
  rSrc.Copy rDest

  'turn off the autofilter
  wsSrc.AutoFilterMode = False
End Sub

'--------------------------------------------
Private Function LastRowCol(Worksht As String) As Long()
Application.Volatile
    Dim WS As Worksheet, R As Range
    Dim LastRow As Long, LastCol As Long
    Dim L(1) As Long
Set WS = Worksheets(Worksht)
With WS
    Set R = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByRows, _
                    searchdirection:=xlPrevious)

    If Not R Is Nothing Then
        LastRow = R.Row
        LastCol = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByColumns, _
                    searchdirection:=xlPrevious).Column
    Else
        LastRow = 1
        LastCol = 1
    End If
End With

L(0) = LastRow
L(1) = LastCol
LastRowCol = L
End Function

И если вы хотите иметь отдельный лист с US строками, вы можете вставить следующее до конца Sub:

'now get the US rows
With wsSrc
    Set rSrc = .Range(.Cells(1, 1), .Cells(LRC(0), LRC(1)))
    .AutoFilterMode = False

    rSrc.AutoFilter _
        field:=filterColumn, _
        Criteria1:="US", _
        visibledropdown:=False

    Set rSrc = rSrc.SpecialCells(xlCellTypeVisible)
    rSrc.Copy rUS
    .AutoFilterMode = False
End With

I предпочитаю сохранять исходные данные, а не удалять материал из источника. Но, если хотите, после того, как вы сделали вышеупомянутое, и вы довольны результатом, просто удалите wsSrc

Редактировать

Приведенный выше код был изменен, так что вы получите, что я думаю, что вы хотите, это рабочие листы («Штат»), содержащие все неамериканские товары; и рабочие листы («Из TaxWise»), содержащие все предметы из США.

Вместо того, чтобы удалять несмежные строки, очень медленный процесс, мы фильтруем строки, которые мы хотим, к новому рабочему листу; удалите исходный лист и переименуйте новый лист.

Не пытайтесь делать это дома без резервного копирования ваших исходных данных.

<час>
Option Explicit
Sub noUS()
    Dim wsSrc As Worksheet, wsDest As Worksheet, wsUS As Worksheet
    Dim rSrc As Range, rDest As Range, rUS As Range
    Const filterColumn As Long = 12
    Dim LRC() As Long

Set wsSrc = Worksheets("From TaxWise")
Set wsDest = Worksheets("State")
    Set rDest = wsDest.Cells(1, 1)
    wsDest.Cells.Clear

With wsSrc
'get last row and column of the source worksheet
    LRC = LastRowCol(.Name)

'set the range
    Set rSrc = .Range(.Cells(1, 1), .Cells(LRC(0), LRC(1)))

'set the filter
  'first turn it off
  .AutoFilterMode = False

  'now set it for the range
  rSrc.AutoFilter _
    field:=filterColumn, _
    Criteria1:="<>US", _
    visibledropdown:=False

  End With

  Set rSrc = rSrc.SpecialCells(xlCellTypeVisible)
  rSrc.Copy rDest

  'turn off the autofilter
  wsSrc.AutoFilterMode = False

  'now get the US rows, may need to add worksheet
On Error Resume Next
Set wsUS = Worksheets("US")
    If Err.Number = 9 Then
        Worksheets.Add
        ActiveSheet.Name = "US"
    End If
Set wsUS = Worksheets("US")
    Set rUS = wsUS.Cells(1, 1)

With wsSrc
    Set rSrc = .Range(.Cells(1, 1), .Cells(LRC(0), LRC(1)))
    .AutoFilterMode = False

    rSrc.AutoFilter _
        field:=filterColumn, _
        Criteria1:="US", _
        visibledropdown:=False

    Set rSrc = rSrc.SpecialCells(xlCellTypeVisible)
    rSrc.Copy rUS
    .AutoFilterMode = False
End With

'Delete Taxwise and rename US sheets
Application.DisplayAlerts = False
wsSrc.Delete
wsUS.Name = "From TaxWise"
Application.DisplayAlerts = True

End Sub

'--------------------------------------------
Private Function LastRowCol(Worksht As String) As Long()
Application.Volatile
    Dim WS As Worksheet, R As Range
    Dim LastRow As Long, LastCol As Long
    Dim L(1) As Long
Set WS = Worksheets(Worksht)
With WS
    Set R = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByRows, _
                    searchdirection:=xlPrevious)

    If Not R Is Nothing Then
        LastRow = R.Row
        LastCol = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByColumns, _
                    searchdirection:=xlPrevious).Column
    Else
        LastRow = 1
        LastCol = 1
    End If
End With

L(0) = LastRow
L(1) = LastCol
LastRowCol = L
End Function
0
ответ дан Ron Rosenfeld 21 January 2019 в 07:45
поделиться

Вы можете фильтровать и работать с видимыми ячейками, или вы можете избежать удаления строк внутри цикла.

Скажем, например, что у вас есть 500 клеток, которые не равны US. После этого у вас будет 500 экземпляров копирования / вставки & amp; удаления. Это крайне неэффективно.

Вместо этого добавьте целевые ячейки в Union (коллекцию ячеек), а затем вне цикла выполните операции с коллекцией. Независимо от того, сколько строк нацелено, у вас будет только один экземпляр копии, один экземпляр вставки и один экземпляр удаления.

Sub Moving()

Dim cs As Worksheet: Set cs = ThisWorkbook.Sheets("From TaxWise")
Dim ps As Worksheet: Set ps = ThisWorkbook.Sheets("State")
Dim MoveMe As Range, myCell As Range, LR2 As Long

Dim LR As Long: LR = cs.Range("L" & cs.Rows.Count).End(xlUp).Row

For Each myCell In cs.Range("L2:L" & LR)
    If myCell <> "US" Then
        If Not MoveMe Is Nothing Then
            Set MoveMe = Union(MoveMe, myCell)
        Else
            Set MoveMe = myCell
        End If
    End If
Next myCell

If Not MoveMe Is Nothing Then
    LR2 = ps.Range("A" & ps.Rows.Count).End(xlUp).Row
        MoveMe.EntireRow.Copy
        ps.Range("A" & LR2).PasteSpecial xlPasteValues
    MoveMe.EntireRow.Delete
End If

End Sub
0
ответ дан urdearboy 21 January 2019 в 07:45
поделиться
Другие вопросы по тегам:

Похожие вопросы: