Как я могу сохранить свои заголовки и устранить смещение в этом скрипте? - PullRequest
0 голосов
/ 01 октября 2018

У меня есть скрипт, который передает данные через «<>», чтобы разделить менеджеров в группе.

Это работает, но я хочу изменить его.Я заменил определенные имена и диапазоны, но он застрял в строке

dest(a,j) = data(I,k)

.Это также изменение размера (очистка содержимого) при переходе к следующему населению менеджера.Раньше он читался как

dest.offset(a,j) = data (I,k)

, но я не использовал смещение, я просто хочу, чтобы он вставлялся нормально.

dest.resize(,columns.count - dest.column).entirecolumn.clearcontents

Я хочучтобы сохранить заголовки, но я не хочу, чтобы там были данные о численности предыдущих сотрудников, а только заголовки, чтобы массив мог вставлять новые данные.

Как я могу взять те два редактирования, которые мне нужны, и реализовать их в этом сценарии:

Option Explicit

Sub MainOne()
  Dim Wb As Workbook
  Dim Data, Last
  Dim i As Long, j As Long, k As Long, a As Long
  Dim Dest As Range

  'Refer to the template
  Set Wb = Workbooks("DummyTemplateBlankWorksheet.xlsm")
  'Refer to the destination cell
  Set Dest = Wb.Sheets("Sheet1").Range("a2")
  'Read in all data
  With ThisWorkbook.Sheets("Data")
    Data = .Range("Y2", .Range("A" & Rows.Count).End(xlUp))
  End With
  Wb.Activate
  Application.ScreenUpdating = False

  'Process the data
  For i = 1 To UBound(Data)
    'Manager changes?
    If Data(i, 1) <> Last Then
      'Skip the first
      If i > 1 Then
        'Scroll into the view
        Dest.Select
        'Save a copy
        Wb.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & _
          ValidFileName(Last & "_Assessment.xlsx")
      End If
      'Clear the employees
      Dest.Resize(, Columns.Count - Dest.Column).EntireColumn.ClearContents
      'Remember this manager
      Last = Data(i, 1)
      'Start the next round
      j = 0
    End If
    'Write the employee data into the template
    a = 0
    For k = 2 To UBound(Data, 2)
      Dest.Offset(a, j) = Data(i, k)
      a = a + 1
    Next
    'Copy the numberformats if we exceed column E

    'Next column
    j = j + 1
  Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...