Question

我创建了一个用户表单，员工可以在其中输入他的信息。参见下表：

    | A             | B            | C            |
5   |               | Empl. ID     |              |
6   |               |              |              |
7   |               | Empl. ID     |              |
8   |               | Last Name    |              |
9   |               | Date of B.   |              |
10  |               | Work         |              |
11  |               | Email        |              |
12  |               | Driving L.   |              |

在C列中，要求员工在各自的单元格（C7：C12）中输入其信息，然后按一下按钮以将数据条目存储在另一个工作表中。在单元格C5中，有一个下拉列表，员工可以使用该下拉列表来检索其数据条目（通过选择其Empl。ID）以进行更改。

现在，如果单元格为空，我想在输入表单中添加默认文本。为此，我有以下代码：

Sub AddDefaultValue()
    With ThisWorkbook
        .Sheets("Entry Form").Range("C7:C48").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Replace What:="", Replacement:="Please enter your information.", _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=_
            False, ReplaceFormat:=False
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
            .Bold = True
        End With
        Selection.Font.Bold = True
    End With
End Sub

我实际上得到了想要的，但是，当我从另一个工作表中检索数据条目时，格式发生了变化（红色和粗体）。我只希望以前输入的信息保持不变。仅当单元格为空时，我才希望默认文本为红色和粗体...

另一个问题是单元格的格式不同（例如，C9的格式为日期）。结果，创建新条目的“按钮”不再起作用。

Option Explicit

'enables data entry via userform

'Declare variables
Type EntryDetails

   EmplID As String
   LastName As String
   DateOfBirth As Date
   Work As String
   Email As String
   DrivingLicense As Integer

End Type

Public EntryRecord As EntryDetails
Public EntryList(1 To 1000) As EntryDetails
Public TempEntryList As Variant
Public PrintEntryList(1 To 1000) As EntryDetails
'Public PrintEntryList(1 To 1000, 1 To 6) As EntryDetails

Sub EntryCreate_Controller()

'orchestrates all subs and functions 

    'retrieve entry list information
    Call get_EntryList
    'add new entry 
    Call get_NewEntry
        With EntryList(get_emptyRecord)
        .EmplID = EntryRecord.EmplID
        .LastName = EntryRecord.LastName
        .DateOfBirth = EntryRecord.DateOfBirth
        .Work = EntryRecord.Work
        .Email = EntryRecord.Email
        .DrivingLicense = EntryRecord.DrivingLicense
End With

        'display entry list
        'Call print_EntryList

End Sub

Function get_emptyRecord()
    Dim counter As Integer  
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then
            get_emptyRecord = counter
            Exit For
        End If
    Next counter
End Function


Function get_EntryExists(EmplID As String) As Boolean
    Dim counter As Integer
    get_ProjectExists = False
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then Exit For
        If EntryList(counter).EmplID = EmplID Then
            get_EntryExists = True
            Exit For
        End If
    Next counter
End Function

Function print_EntryList()
    Dim counter
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then Exit Function
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 0).Value = EntryList(counter).EmplID
       If EntryList(counter).LastName <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 1).Value = EntryList(counter).LastName
       End If
       If EntryList(counter).DateOfBirth <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 2).Value = EntryList(counter).DateOfBirth
       End If
       If EntryList(counter).Work <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 3).Value = EntryList(counter).Work
       End If
       If EntryList(counter). Email <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 4).Value = EntryList(counter).Email
       End If
       If EntryList(counter). DrivingLicense <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 5).Value = EntryList(counter).DrivingLicense
       End If
    End if
    Next counter
End Function

Function get_NewEntry()
    'initialize variables
    With EntryRecord
    .EmplID = Sheets("Entry Form").Range("Form_EmplID").Value
    .LastName = Sheets("Entry Form").Range("Form_LastName").Value
    .DateOfBirth = Sheets("Entry Form").Range("Form_DateOfBirth").Value
    .Work = Sheets("Entry Form").Range("Form_Work").Value
    .Email = Sheets("Entry Form").Range("Form_Email").Value
    .DrivingLicense = Sheets("Entry Form").Range("Form_DrivingLicense").Value
End With
End Function

Function get_EntryList()
TempEntryList = Sheets("Data Entries").Range("EntryListStart").Range("A1:F10000").Value
    Dim counter As Integer
    For counter = 1 To 1000
        If TempEntryList(counter, 1) = Empty Then Exit For
            With EntryList(counter)
            .EmplID = TempEntryList(counter, 1)
            .LastName = TempEntryList(counter, 2)
            .DateOfBirth = TempEntryList(counter, 3)
            .Work = TempEntryList(counter, 4)
            .Email= TempEntryList(counter, 5)
            .DrivingLicense = TempEntryList(counter, 6)
            End With
    Next counter

    get_EntryList = True
End Function

Answer 1

我建议使用条件格式。因此，如果单元格包含Please enter your information.，则它们会自动变为红色和粗体格式；如果用户输入其他内容，则它们会自动返回其先前的格式。

您可以手动设置一次规则，然后使用：

Option Explicit

Public Sub AddDefaultValue()
    With ThisWorkbook.Sheets("Entry Form").Range("C7:C48")   
        If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then         
            .SpecialCells(xlCellTypeBlanks).Value = "Please enter your information."
        End If
    End With
End Sub

或者您也通过代码设置条件：

Option Explicit

Public Sub AddDefaultValue()
    With ThisWorkbook.Sheets("Entry Form").Range("C7:C48")
        .FormatConditions.Delete

        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Please enter your information.""").Font
            .Bold = True
            .Color = -16776961
            .TintAndShade = 0
        End With

        If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then
            .SpecialCells(xlCellTypeBlanks).Value = "Please enter your information."
        End If
    End With
End Sub

另外，我建议阅读：How to avoid using Select in Excel VBA。

在Excel VBA中为空单元格设置默认值

1 个答案: