Excel Forum

Code: Select all

Private sName As String
Private r As Range

Private Sub CommandButton1_Click()
    sName = "เนื้อ"
    Call InsertSName
End Sub

Private Sub CommandButton2_Click()
    sName = "หมู"
    Call InsertSName
End Sub

Private Sub CommandButton3_Click()
    sName = "ไก่"
    Call InsertSName
End Sub

Public Sub InsertSName()
    On Error Resume Next
    Set r = Range("b8:h19").SpecialCells(xlCellTypeBlanks).Range("a1")
    If Err.Number = 1004 Then
        MsgBox "ไม่พบพื้นที่ว่าง"
        Exit Sub
    ElseIf r.Address(0, 0) <> "B8" And r.Offset(20, -1).End(xlUp).Row <> 19 Then
        Set r = r.Offset(20, -1).End(xlUp).Offset(1, 0)
    End If
    r.Value = sName
    If r.Row = 19 Then
        If r.Column <> 8 Then _
            r.End(xlUp).Offset(0, 1).Select
    Else
        r.Offset(1, 0).Select
    End If
End Sub

Code: Select all

Public Sub InsertSName()
    Dim i As Integer, j As Integer, k As Byte
    Set r = ActiveSheet.Range("i8").End(xlToLeft)
    If r.Value = sName Then
        For i = 1 To 2
            If k = 1 Or r.Offset(, i - 1).Column = 9 Then Exit For
            For j = 1 To 12
                If r.Offset(j - 1, i - 1).Value = "" Then
                    r.Offset(j - 1, i - 1).Value = sName
                    k = k + 1
                    Exit For
                End If
            Next j
        Next i
    Else
        If r.Offset(, 1).Column = 9 Then Exit Sub
        r.Offset(, 1).Value = sName
    End If
End Sub

Code: Select all

Global refCell As Range
Global xStr As String
Global rOffset As Single

Code: Select all

Private Sub CommandButton1_Click()
xStr = CommandButton1.Caption
GetStr
End Sub
Private Sub CommandButton2_Click()
xStr = CommandButton2.Caption
GetStr
End Sub
Private Sub CommandButton3_Click()
xStr = CommandButton3.Caption
GetStr
End Sub
Private Sub CommandButton4_Click()
Set refCell = [d8]
xStr = ""
rOffset = 0
refCell.CurrentRegion.ClearContents
End Sub
Private Sub GetStr()
If xStr <> refCell.Value Then
    rOffset = 0
    Set refCell = refCell.Offset(0, 1)
End If
refCell.Offset(rOffset, 0).Value = xStr
rOffset = rOffset + 1
End Sub