Giúp đỡ code VBA cho xử lí sheet (1 người xem)

bienda · 5/2/18

Tình hình em có bảng excel gồm 2 sheets
Sheet1 là bảng có thể thay đổi về số lượng cột và số lượng hàng
Sheet2 phụ thuộc vào sheet1

Vâng em xin lỗi các bác, do vội quá nên em thiếu sót

Mong muốn của em ở Sheet2 là
Dòng 1 cố định
Dòng 2,3 sẽ cố định số lượng là 2 theo cột R101, nếu là R102 thì sẽ thay vị trí R101 bằng R102
Dòng 4,5 có thể có nhiều hơn 2 dòng phụ thuộc hệ số trong bảng , nếu có hệ số # 0 thì sẽ cho tên của cột Cxxx và hệ số của cột tương ứng vào chuỗi như thể hiện ở Sheet2

Các bác làm ơn giúp em cái sub để xử lí dữ liệu với, em loay hoay mãi mà vẫn lỗi

bienda · 6/2/18

Có bác nào đi qua giúp em với ạ, Em đang bị tắc

giaiphap · 6/2/18

bienda đã viết:
Có bác nào đi qua giúp em với ạ, Em đang bị tắc

Tôi cũng muốn giúp nhưng lại không biết giúp bạn cái gì luôn, xử lý cái quái gì vậy? xử lý ra sao? Ít nhất bạn phải giải thích để mọi người biết mà xử lý chứ.

bienda · 6/2/18

giaiphap đã viết:
Tôi cũng muốn giúp nhưng lại không biết giúp bạn cái gì luôn, xử lý cái quái gì vậy? xử lý ra sao? Ít nhất bạn phải giải thích để mọi người biết mà xử lý chứ.

Dạ bác xem bảng excel của em thì bác hiểu liền mà
Em có sheet1 chứa dữ liệu bảng, còn sheet2 là kết quả sau khi xử lí từ sheet1, nhưng có chèn thêm các text vào như thể hiện

HieuCD · 6/2/18

bienda đã viết:
Tình hình em có bảng excel gồm 2 sheets
Sheet1 là bảng có thể thay đổi về số lượng cột và số lượng hàng
Sheet2 phụ thuộc vào sheet1

Các bác làm ơn giúp em cái sub để xử lí dữ liệu với, em loay hoay mãi mà vẫn lỗi

Mã:

Sub GPE()
  Dim dArr As Variant, sArr As Variant, Arr As Variant, S As Variant
  Dim i As Long
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    dArr = .Range("A2:A" & i).Value
  End With
  With Sheets("Sheet1")
    sArr = .Range("A1:J5").Value
  End With
  ReDim Arr(1 To UBound(sArr, 1) - 1, 1 To UBound(sArr, 2) - 1)
  With CreateObject("scripting.dictionary")
    For i = 2 To UBound(sArr)
      .Item(sArr(i, 1)) = i - 1
    Next i
    For i = 2 To UBound(sArr, 2)
      .Item(sArr(1, i)) = i - 1
    Next i
    For i = 1 To UBound(dArr)
      S = Split(dArr(i, 1))
      If UBound(S) = 4 Then
        If .exists(S(0)) And .exists(S(2)) Then
          Arr(.Item(S(0)), .Item(S(2))) = S(4)
        Else
          MsgBox (dArr(i, 1) & ": khong có trong bang ket qua")
        End If
      End If
    Next i
  End With
  With Sheets("Sheet1")
    .Range("B2:J2").Resize(UBound(Arr)).Value = Arr
  End With
End Sub

bienda · 6/2/18

HieuCD đã viết:

Mã:

Sub GPE()
  Dim dArr As Variant, sArr As Variant, Arr As Variant, S As Variant
  Dim i As Long
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    dArr = .Range("A2:A" & i).Value
  End With
  With Sheets("Sheet1")
    sArr = .Range("A1:J5").Value
  End With
  ReDim Arr(1 To UBound(sArr, 1) - 1, 1 To UBound(sArr, 2) - 1)
  With CreateObject("scripting.dictionary")
    For i = 2 To UBound(sArr)
      .Item(sArr(i, 1)) = i - 1
    Next i
    For i = 2 To UBound(sArr, 2)
      .Item(sArr(1, i)) = i - 1
    Next i
    For i = 1 To UBound(dArr)
      S = Split(dArr(i, 1))
      If UBound(S) = 4 Then
        If .exists(S(0)) And .exists(S(2)) Then
          Arr(.Item(S(0)), .Item(S(2))) = S(4)
        Else
          MsgBox (dArr(i, 1) & ": khong có trong bang ket qua")
        End If
      End If
    Next i
  End With
  With Sheets("Sheet1")
    .Range("B2:J2").Resize(UBound(Arr)).Value = Arr
  End With
End Sub

Em cảm ơn bác nhưng bác hiểu sai ý em rồi, em Sheet2 của em phụ thuộc sheet1 cơ ạ
Code của em như sau, nhưng có gì đó sai ạ.
Vòng lặp của em theo hàng của sheet1 nhưng chèn thêm 2 dòng đầu và phụ thuộc cả vào số lượng cột của sheet1 nếu có giá trị # 0

Mã:

Sub test()
Dim Ncol, Nrow, i, j, ind As Integer
Dim WS, WS1 As Worksheet
Dim n As Long
Dim D1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18 As String

D3 = "CCCC"
D5 = "BBBB"
D11 = "AAAA"
D15 = "XXXX"
D17 = "MMMM"
D18 = "NNNN"


Set WS1 = ActiveSheet
Set WS2 = Sheets.Add(after:=WS1)

WS2.Name = "SHEET3"


Ncol = WS1.Cells(1, Columns.count).End(xlToLeft).Column
Nrow = WS1.UsedRange.Rows.count

    With WS2
        .Cells(1, 1) = "COMBINATIONS"
        ind = 0
        For i = 2 To Nrow
            For j = 2 To Ncol
                If WS1.Cells(i, j) <> vbNullString Then
                    .Cells(ind + i + j - 2, 1) = D11 + WS1.Cells(i, 1) + D3 + D12 + D3 + D13
                    .Cells(ind + i + j - 1, 1) = D11 + WS1.Cells(i, 1) + D3 + D14 + D3 + D15 + D3 + D16 + D3 + D17
                    .Cells(ind + i + j, 1) = D11 + WS1.Cells(i, 1) + D3 + D5 + WS1.Cells(1, j) + D18 + WS1.Cells(i, j)
                ind = ind + 2
                End If
            Next j         
        Next i 
    End With

End Sub

giaiphap · 6/2/18

bienda đã viết:
Em cảm ơn bác nhưng bác hiểu sai ý em rồi, em Sheet2 của em phụ thuộc sheet1 cơ ạ

Cái ngạy của tôi là chổ này, giúp cho bạn xong thì bạn nói hiểu sai ý, mà tôi có thấy ý của bạn chổ nào đâu mà hiểu đúng. Bạn chỉ đưa sheet mẫu mà chẳng có giải thích gì thì ai biết bạn muốn cái gì, người ta chỉ giúp theo hiểu biết của người ta thôi.

bienda · 6/2/18

Em xin lỗi các bác, do vội quá nên em thiếu sót a

Mong muốn của em ở Sheet2 là
Dòng 1 cố định
Dòng 2,3 sẽ cố định số lượng là 2 theo cột R101, nếu là R102 thì sẽ thay vị trí R101 bằng R102
Dòng 4,5 có thể có nhiều hơn 2 dòng phụ thuộc hệ số trong bảng , nếu có hệ số # 0 thì sẽ cho tên của cột Cxxx và hệ số của cột tương ứng vào chuỗi như thể hiện ở Sheet2

giaiphap · 6/2/18

bienda đã viết:
Em xin lỗi các bác, do vội quá nên em thiếu sót a

Mong muốn của em ở Sheet2 là
Dòng 1 cố định
Dòng 2,3 sẽ cố định số lượng là 2 theo cột R101, nếu là R102 thì sẽ thay vị trí R101 bằng R102
Dòng 4,5 có thể có nhiều hơn 2 dòng phụ thuộc hệ số trong bảng , nếu có hệ số # 0 thì sẽ cho tên của cột Cxxx và hệ số của cột tương ứng vào chuỗi như thể hiện ở Sheet2

Thế bạn dùng tạm code này xem sao.

Mã:

Sub GPE()
Dim Arr(), dArr(), i As Integer, j As Integer, k As Long
Arr = Sheet1.Range("A1", Sheet1.Range("A65000").End(xlUp)).Resize(, 10).Value
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 1)
k = 0
For i = LBound(Arr, 1) + 1 To UBound(Arr, 1)
    k = k + 1: dArr(k, 1) = Arr(i, 1) & " AAAA BBBB"
    k = k + 1: dArr(k, 1) = Arr(i, 1) & " XXXX YYYY"
    For j = LBound(Arr, 2) + 1 To UBound(Arr, 2)
        If Arr(i, j) <> "" Then
            k = k + 1: dArr(k, 1) = Arr(i, 1) & " TTTT " & Arr(LBound(Arr, 1), j) & " UUUU " & IIf(Left(Arr(i, j), 1) = ",", "0", "") & Arr(i, j)
        End If
    Next j
Next i
Sheet2.Cells.Clear
Sheet2.Range("A1").Value = "tittle"
If k > 0 Then Sheet2.Range("A2").Resize(k) = dArr
End Sub

bienda · 6/2/18

giaiphap đã viết:
Thế bạn dùng tạm code này xem sao.

Bác ơi, em chạy không xuất hiện cái gì, nếu bác rảnh bác xem lại hộ em với. Em cảm ơn nhiều

giaiphap · 6/2/18

bienda đã viết:
Bác ơi, em chạy không xuất hiện cái gì, nếu bác rảnh bác xem lại hộ em với. Em cảm ơn nhiều

Bạn xem thử file.

bienda · 6/2/18

giaiphap đã viết:
Bạn xem thử file.

Cảm ơn bác rất nhiều

Giúp đỡ code VBA cho xử lí sheet (1 người xem)

Người dùng đang xem chủ đề này

bienda

Thành viên chính thức

File đính kèm

bienda

Thành viên chính thức

giaiphap

==(^o^)==

bienda

Thành viên chính thức

HieuCD

Chuyên gia GPE

bienda

Thành viên chính thức

giaiphap

==(^o^)==

bienda

Thành viên chính thức

giaiphap

==(^o^)==

bienda

Thành viên chính thức

giaiphap

==(^o^)==

File đính kèm

bienda

Thành viên chính thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian