Snasui Excel Forum

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If
Sheets("Rev").Range("A6:A40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6:C6", .Range("B6").End(xlDown)) ' โค๊ดที่ปรับแก้ไข
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
            i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
End Sub

Code: Select all

With Sheets(strNameSheet)
    Set rcAll = .Range("B6:C6", .Range("B6").End(xlDown)) ' โค๊ดที่ปรับแก้ไข
End With

Code: Select all

Sub Test()
    Dim rAll As Range
    Dim r As Range
    Dim rSource As Range
    With Sheets("Oct")
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    End With
    With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, 2)
    End With
    For Each r In rAll
      r.Offset(0, 1) = Application.VLookup(r, rSource, 2, 0)
    Next r
End Sub

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Dim rAll As Range, rt As Range, rSource As Range
 

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If
Sheets("Rev").Range("A6:A40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
    Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    'Set rcAll = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
End With
With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
           .SpecialCells(xlCellTypeConstants, 2)
     End With
For Each rt In rAll
     rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
     'rt.Offset(0, 1) = Application.VLookup(rt, rcAll, 2, 0)
     Next rt
For Each r In rcAll
      With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
        
          i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
End Sub

Code: Select all

strNameSheet = InputBox("Please enter sheet name.")

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Dim rAll As Range, rt As Range, rSource As Range

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If

Sheets("Rev").Range("A6:A40,B6:B40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
    Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    'Set rcAll = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
   End With
With Sheets("Rev")
For Each r In rcAll
      With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
        
          i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
'Call Test
With Sheets("Rev")
      Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, 2)
    End With
    For Each rt In rAll
         rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
        Next rt
   End With
End Sub

Code: Select all

Sub PasteWithDifSize()
    Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
    Dim rrAll As Range, rcAll As Range, rp As Range
    Dim r As Range, r1 As Range
    Dim rAll As Range, rt As Range, rSource As Range
    
    Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
    strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
    For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next s
    If sCount = 0 Then
          MsgBox "Sheet name is incorrect. Please try again."
          Exit Sub
    End If
    Sheets("Rev").Range("A6:A40,B6:B40,E6:R40").ClearContents
    With Sheets(strNameSheet)
        Set rcAll = .Range("B6", .Range("B6").End(xlDown))
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    End With
    With Sheets("Rev")
        For Each r In rcAll
'            With Sheets("Rev")
             If .Range("E6") = "" Then
                 Set rp = .Range("E6").Resize(2, 10)
             Else
                 Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
            End If
'            End With
            i = 0: j = 0: c = 0
            If r.Offset(0, -1) <> "" Then
                rp.Cells(1, 0).Offset(0, -3) = r
                Set rrAll = r.Offset(0, 2).Resize(1, 31)
                For Each r1 In rrAll
                  i = i + 1
                    If r1 = "บ" Or r1 = "ด" Or r1 = "ชบ" Or r1 = "ชด" Then
                        c = c + 1
                        j = Int((c - 1) / 10) + 1
                        k = (c - 1) Mod 10 + 1
                        rp.Cells(j, k) = i
                    End If
                Next r1
                rp.Cells(1, 1).Offset(0, 10) = c
                rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
                rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
            End If
        Next r
        'With Sheets("Rev")
        With .Range("M2")
            .Value = 1 & strNameSheet & Year(Date)
            .NumberFormat = "mmmm"
        End With
        For Each r In .Range("E6:E40")
            If r = "" Then
                r.EntireRow.Hidden = True
            End If
        Next r
        'End With
        'With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
              .SpecialCells(xlCellTypeConstants, 2)
        'End With
        For Each rt In rAll
             rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
        Next rt
    End With
End Sub

Code: Select all

If r1 = "^(O)" Or r1 = "?" Or r1 = "^(a)^(O)" Or r1 = "^(a)?" Then

Code: Select all

If r1 = "ชบ" Or r1 = "ชด" Or r1 = "บ" Or r1 = "ด" Then

Code: Select all

If r1 = "^(O)" Or r1 = "?" Or r1 = "^(a)^(O)" Or r1 = "^(a)?" Then

Code: Select all

Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeConstants, 2)

Code: Select all

Set rAll = .Range("A6", .Range("A41").End(xlUp)) _
    .SpecialCells(xlCellTypeConstants, 2)

Code: Select all

With Sheets(strNameSheet)
        Set rcAll = .Range("B6", .Range("B6").End(xlDown))
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
        Set rNo = .Range("B6", .Range("D" & Rows.Count).End(xlUp))
        Set rOt = .Range("B6", .Range("E" & Rows.Count).End(xlUp))
    End With