Question

我在这里有一些代码很好，但我想微调一下。现在，宏将三行值复制到新工作簿。粘贴这些值时没有任何格式。并非所有单元格的内容都可见，因为有时列宽不够大。我的问题如下：如何更改下面提供的代码，以便根据粘贴的第一行中的文本使列变大。
如何根据第一行中的内容自动调整列？

代码：

Public Sub pub_sub_ExportRows()

'#
'# declare private variables
'#
     Dim pvt_xls_Current As Excel.Worksheet
     Dim pvt_wbk_New As Excel.Workbook
     Dim pvt_lng_SelectedSourceRow As Long
     Dim pvt_flg_ValidRow As Boolean
     Dim pvt_lng_RowNumber As Long
     Dim pvt_lng_FirstColumn As Long
     Dim pvt_lng_LastColumn As Long
     Dim pvt_lng_ColumnNumber As Long
     Dim pvt_lng_TargetColumn As Long

'#
'# record the current row based on the active cell
'#
     Set pvt_xls_Current = ThisWorkbook.ActiveSheet
     pvt_lng_SelectedSourceRow = ActiveCell.Row

'#
'# the maximum number of columns to be considered is not dependent on the columns        defined in the
'# worksheet, but rather by a limit imposed by the user - i.e. column HG is the last       column to be copied,
'# and column Q is the first column to be considered
'#
     pvt_lng_FirstColumn = Columns("Q").Column
     pvt_lng_LastColumn = Columns("HG").Column
     pvt_lng_TargetColumn = 0

'#
'# check if the selected row is valid by examining the values in the columns on that
'# row - any non-blank value implies that the selected row is valid - when looking at
'# the values the search starts in column Q as requested by the user
'#
     With pvt_xls_Current
          pvt_flg_ValidRow = False
          For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn
               If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 Then
                    pvt_flg_ValidRow = True
                    Exit For
               End If
          Next pvt_lng_ColumnNumber
     End With

     If Not pvt_flg_ValidRow Then
          MsgBox "You must select a valid - i.e. non empty - row"
          Exit Sub
     End If

     If pvt_lng_SelectSourceRow > 10000 Then
          MsgBox "You may not select a row > 10000"
          Exit Sub
     End If

'#
'# create a new workbook to hold the copied values and copy & paste the information to   the
'# newly created workbook
'#
     Set pvt_wbk_New = Application.Workbooks.Add
     With pvt_xls_Current
          For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn

               If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 And _
                    InStr(1, "$AF,$BF,$CG,$DH,$ES,$FV,$HD,$HF",    Split(Columns(pvt_lng_ColumnNumber).Address, ":")(0)) = 0 Then
                         pvt_lng_TargetColumn = pvt_lng_TargetColumn + 1
                         pvt_wbk_New.Worksheets("Sheet1").Cells(1,    pvt_lng_TargetColumn).Value = .Cells(4, pvt_lng_ColumnNumber).Value
                         pvt_wbk_New.Worksheets("Sheet1").Cells(2,   pvt_lng_TargetColumn).Value = .Cells(5, pvt_lng_ColumnNumber).Value
                         pvt_wbk_New.Worksheets("Sheet1").Cells(3,  pvt_lng_TargetColumn).Value = .Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value
               End If

          Next pvt_lng_ColumnNumber
     End With

'#
'# activate the new workbook
'#
     pvt_wbk_New.Activate
End Sub

Answer 1

这将自动调整设置为值的第一个单元格的整行。显然可以简化为指示第1行，但我试图复制您使用的代码：

 pvt_wbk_New.Worksheets("Sheet1").Cells(1,pvt_lng_TargetColumn).EntireRow.Columns.Autofit

根据行的内容将代码更改为自动调整列宽

1 个答案: