如何仅将格式化的单元格复制到vba中具有列名称的行中

时间:2015-10-15 14:20:03

标签: excel-vba vba excel

如何将格式化的单元格从一个工作表复制到另一个工作表,其行名称来自excel中的vba

1 个答案:

答案 0 :(得分:1)

您的问题已被拒绝投票,因为它不符合本网站的规定。在搜索框左侧的顶部栏是[help]。我认为观看巡回赛和帮助中心将有助于您提出欢迎来到这里的问题。

你的问题的主要问题是:(1)它是模糊的,(2)你没有努力尝试自己解决问题,(3)听起来好像你希望有人为你编写一个宏。

我将假设您的大问题是您不知道如何确定单元格是否具有非默认格式。如果您搜索过“excel vba粗体文本”,您会发现一些提供有用背景的页面。尝试将您的问题缩小到一个问题,通常很容易找到一些相关的帮助。

下面的宏应该复制到新的工作簿中。它格式化一些单元格,然后在立即窗口中显示这些格式。逐行完成该宏,并研究如何设置和确定每个单元格的格式。但首先是一些背景。

细胞只能有一种内部或背景颜色。它不能是半红色和半蓝色。您可以使用单元格属性.Interior.Color.Interior.ColorIndex设置或读取内部颜色。我将演示如何使用ColorIndex进行设置并使用其中任何一个进行读取。

细胞可以粗体混合。也就是说:部分文本可以是粗体,部分不是粗体。我演示了如何设置整个文本粗体以及如何设置文本粗体的前四个字符。当我检查单元格的粗体状态时,您会看到我使用IsNull检查混合状态,然后再检查是否为粗体。这个顺序很重要。如果你想知道原因,请尝试反过来。

与粗体一样,字体颜色可以混合使用。与背景颜色一样,您可以使用.Font.Color.Font.ColorIndex设置和阅读。

我希望这能让你开始。

Option Explicit
Sub Demo()

  Dim ColCrnt As Long
  Dim RowCrnt As Long
  Dim WshtSrc As Worksheet
  Dim WshtDest As Worksheet

  Set WshtSrc = Worksheets("Sheet1")        ' Source worksheet
  Set WshtDest = Worksheets("Sheet2")       ' Destination worksheet

  With WshtSrc

    .Cells.EntireRow.Delete

    ' Format selected cells in the range A1:C4

    With .Cells(1, 1)
      .Value = "Cell A1"
    End With
    With .Cells(1, 2)
      .Value = "Cell B1"
      .Font.Bold = False
    End With
    With .Cells(1, 3)
      .Value = "Cell C1"
      .Font.Bold = True
    End With
    With .Cells(1, 4)
      .Value = "Cell D1"
      .Characters(1, 4).Font.Bold = True
    End With

    With .Cells(2, 1)
      .Value = "Cell A2"
    End With
    With .Cells(2, 2)
      .Value = "Cell B2"
      .Interior.ColorIndex = xlAutomatic
    End With
    With .Cells(2, 3)
      .Value = "Cell C2"
      .Interior.ColorIndex = 2
    End With
    With .Cells(2, 4)
      .Value = "Cell D2"
      .Interior.ColorIndex = 15
    End With

    With .Cells(3, 1)
      .Value = "Cell A3"
    End With
    With .Cells(3, 2)
      .Value = "Cell B3"
      .Font.Color = RGB(0, 0, 0)
    End With
    With .Cells(3, 3)
      .Value = "Cell C3"
      .Font.Color = RGB(255, 0, 0)
    End With
    With .Cells(3, 4)
      .Value = "Cell D3"
      .Characters(1, 4).Font.Color = RGB(0, 0, 255)
    End With

    For RowCrnt = 1 To 3
      For ColCrnt = 1 To 4
        Debug.Print "Cell " & ColNumToCode(ColCrnt) & RowCrnt & " is ";

        If IsNull(.Cells(RowCrnt, ColCrnt).Font.Bold) Then
          Debug.Print "mixed bold font";
        ElseIf .Cells(RowCrnt, ColCrnt).Font.Bold = True Then
          Debug.Print "bold font";
        Else
          Debug.Print "not bold font";
        End If

        Debug.Print ", ";

        If .Cells(RowCrnt, ColCrnt).Interior.ColorIndex = xlColorIndexNone Then
          Debug.Print "Interior colour index=None (background white)";
        ElseIf .Cells(RowCrnt, ColCrnt).Interior.ColorIndex = xlColorIndexAutomatic Then
          Debug.Print "Interior colour index=Automatic (background white)";
        ElseIf .Cells(RowCrnt, ColCrnt).Interior.ColorIndex = 2 Then
          Debug.Print "Interior colour index=2 (background white)";
        Else
          Debug.Print "Interior colour index=" & .Cells(RowCrnt, ColCrnt).Interior.ColorIndex & " (background not white";
        End If

        Debug.Print ", ";

        If .Cells(RowCrnt, ColCrnt).Interior.Color = RGB(255, 255, 255) Then
          Debug.Print "Interior colour number=" & .Cells(RowCrnt, ColCrnt).Interior.Color & " (background white)";
        Else
          Debug.Print "Interior colour number=" & .Cells(RowCrnt, ColCrnt).Interior.Color & " (background not white)";
        End If

        Debug.Print " and ";

        If IsNull(.Cells(RowCrnt, ColCrnt).Font.Color) Then
          Debug.Print "font colour mixed";
        ElseIf .Cells(RowCrnt, ColCrnt).Font.Color = RGB(0, 0, 0) Then
          Debug.Print "font black";
        Else
          Debug.Print "font not black (Font colour number=" & .Cells(RowCrnt, ColCrnt).Font.Color & ")";
        End If

        Debug.Print

      Next
    Next

  End With

End Sub
Function ColNumToCode(ByVal ColNum As Long) As String

  Dim ColCode As String
  Dim PartNum As Long

  ' Last updated 3 Feb 12.  Adapted to handle three character codes.

  If ColNum = 0 Then
    ColNumToCode = "0"
  Else
    ColCode = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      ColCode = Chr(65 + PartNum) & ColCode
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

  ColNumToCode = ColCode

End Function