Chuyển đổi dữ liệu

**sangame** · 09-05-2008, 08:03 AM

Em xin cám ơn các anh !!!
Cám ơn anh SA_DQ nhiều nhiều, em làm cái bảng tính này mệt lắm cứ cộng, trừ rồi lại dò số 0, nhiều lúc nhầm lung tung. Tối qua e mới viết lên mong các anh chỉ giúp, hôm nay đã có bài trả lời rồi, thực lòng cám ơn anh nhiều, chúc anh sức khỏe và thành công! Cho em xin hỏi mọt chút nữa: Sau khi em sủa lại tên sheet viết liền nhau, em copy code vào cửa sổ VBA để chạy nhưng chương trình cứ yêu cầu tạo thêm maco nữa. Em cũng không biết nhiều lắm mon anh giúp em !!!

View more random threads:

trungtrinh · 09-05-2008, 09:19 AM

Em có một bảng tính (file gửi kèm)
Em muốn lập một cái macco hay công thức để chuyển đổi dữ liệu như em đã minh họa trên.
- Tại cột A* (ví dụ A8) nhập vào trừ giá trị đầu tiên có giá trị là 0, các ô sau nếu có giá trị là 0 thì chuyển sang ô G* (ví dụ G8) tương ứng
- Các ô trên giá trị 0
G7=G8+A7
G6=G7+A6
......
G3 (dưới ô có giá trị S) = G4+A3
- Các o dưới giá trị 0
G9=G8+A9
G10=G9+A10
.....
G16(trên ô có giá trị E)=G15+A16

- Khi ô A* (ví dụ A8) có giá trị 0 thì chuyển nguyên ô B* (ví dụ B8) sang ô H* (ví dụ H8)
- Các ô trên giá trị 0
H7=$B$8+B7
H6=$B$8+B6
......
H3=$B$8+B3
- Các o dưới giá trị 0
H9=$B$8+B9
H10=$B$8+B10
.....
H16=$B$8+B16
- Các ô màu xanh chuyển sang tương ứng
Thực hiện chuyển đổi hết dữ liệu sang như em đã mô tả trên.
Rất mong các anh chỉ bảo giúp em. Em xin chân thành cảm ơn !!!

**phuongaudio** · 09-05-2008, 10:17 AM

Mã nguồn PHP:


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error Resume Next
 Dim jZ As Long
  
 If Not Intersect(Target, Range("A2:A999")) Is Nothing And Target = 0 Then
    With Target
        .Offset(, 6) = 0:                           jZ = .Row
        .Offset(, 7) = .Offset(, 1)
    End With
    Do
        jZ = jZ - 1
        If IsNumeric(Cells(jZ, 1)) = False Then
            Cells(jZ, 7).Interior.ColorIndex = Cells(jZ, 1).Interior.ColorIndex
            Cells(jZ, 7) = Cells(jZ, 1):                      Exit Do
        End If
            Cells(jZ, 7) = Cells(jZ + 1, 7) + Cells(jZ, 1)
            Cells(jZ, 8) = Cells(jZ + 1, 8) + Cells(jZ, 2)
    Loop
    jZ = Target.Row
    Do
        jZ = jZ + 1
        If IsNumeric(Cells(jZ, 1)) = False Then
            Cells(jZ, 7).Interior.ColorIndex = Cells(jZ, 1).Interior.ColorIndex
            Cells(jZ, 7) = Cells(jZ, 1):            Exit Do
        End If
            Cells(jZ, 7) = Cells(jZ - 1, 7) + Cells(jZ, 1)
            Cells(jZ, 8) = Cells(jZ - 1, 8) + Cells(jZ, 2)
    Loop
 End If
End Sub

Hướng dẫn bạn 1 chút:
* Macro đang trong sheets("NguyenGoc") & mình đã thử chạy nó bằng cách tại ô A8 mình nhập số '0' & {ENTER}, macro đã thể hiện cách làm theo iêu cầu của bạn;
Còn 1 vài số '0' trên cột 'A', bạn có thể tiếp tục thử cho thành thục;
* Mình chưa rõ lắm; như theo quy trình thì dẫy số trên & dưới số 0 trên cột 'A' đã phải có? Nếu không đủ thì macro sẽ thực thi nữa vời mà thôi!

Chờ tin bạn!

huutrangqb · 09-05-2008, 11:47 AM

Mình cảm ơn bạn nhiều lắm. Ý mình la minh không biết làm thế nào đê chạy cái đoạn mã bạn viết. Mình copy vào cửa sổ VBA sau đó chạy nhưng nó cứ báo răng cần phải đặt cái MACO mình cũng không biết phải làm thế nào nữa.
Bạn thông cảm cho minh nhé, vì mình thực sự không rành lắm ! Nếu có thể bạn gửi lại cho mình cái file ma bạn chạy được không ? Cảm ơn bạn rất nhiều !!!

vsneakerq · 09-05-2008, 11:52 AM

Hãy dùng công thức IF cho đơn giản.

quangngoc93 · 09-05-2008, 02:26 PM

Gửi bởi chibi

Hãy dùng công thức IF cho đơn giản.

Bằng giá trị ô B8 tương ứng với ô khi A8 có giá trị bằng 0 :

Mã nguồn PHP:


= IF(A8=0,B8,"")

Tương tự các Ô khác

Chúc thành công!

Mrhieuson · 09-05-2008, 02:40 PM

* Bạn phải chuột lên thanh sheetName có tên là 'NguyenGoc' (Chú í: Tên các sheets nên viết liền - không có khoảng trống; Điều này không bắt buộc, cũng giống như ta muốn đi 1 chân trên vĩa hè & 1 chân dưới lòng đường cũng không ai cấm!)
* Chọn dòng cuối của CS vừa đổ xuống
* Chép toàn bộ macro này vô CS VBE vừa xuất hiện;

Chúc thành công!

Mã nguồn PHP:


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error Resume Next
 Dim jZ As Long
 
 If Not Intersect(Target, Range("A2:A999")) Is Nothing And Target = 0 Then
    With Target
        .Offset(, 6) = 0:                           jZ = .Row
        .Offset(, 7) = .Offset(, 1)
    End With
    Do
        jZ = jZ - 1
        If IsNumeric(Cells(jZ, 1)) = False Then
            Cells(jZ, 7) = Cells(jZ, 1):            Exit Do
        End If
            Cells(jZ, 7) = Cells(jZ + 1, 7) + Cells(jZ, 1)
            Cells(jZ, 8) = Cells(jZ + 1, 8) + Cells(jZ, 2)
    Loop
    jZ = Target.Row
    Do
        jZ = jZ + 1
        If IsNumeric(Cells(jZ, 1)) = False Then
            Cells(jZ, 7) = Cells(jZ, 1):            Exit Do
        End If
            Cells(jZ, 7) = Cells(jZ - 1, 7) + Cells(jZ, 1)
            Cells(jZ, 8) = Cells(jZ - 1, 8) + Cells(jZ, 2)
    Loop
 End If
End Sub

sutuhong123 · 09-05-2008, 06:19 PM

Được rồi. Tốt quá anh ạ. Em lại không hiểu cách sử dụng lắm lên cứ lơ mơ. Em đã làm lại đúng như anh hướng dẫn là được rồi. Có một số chỗ không tự động copy giá trị "EG" sang. Cho em xin hỏi có thể chỉnh lại đê khi mình đã có một bảng nhập số liệu rồi chỉ cần kích một cái vào một nút là chạy chuyển cả bảng không anh? Em cảm ơn anh SA_DQ nhiều lắm !!!

**tai camera360** · 10-05-2008, 10:23 AM

Đọc kỹ hướng dẫn sử dụng trước khi dùng:

Nút chạy macro mình để bên sheets("S1")
Trước khi chạy, ta sang sheets thứ 2, chọn các cột trước cột 'I'
bấm {CTRL}+C;
Sang sheets có nút lệnh & chọn 'A1'
Vô menu Edit để dán Special, & chọn All trong CS vừa xuất hiện.

Chúc thành công.[IMG]images/smilies/biggrin.png[/IMG]

Mã:

Sub GPE_com(Clls As Range, VTri0 As Long)
 Dim mRow As Long, Zz As Long, RowM As Long
 Dim GTri0 As Double:               Dim Rng As Range, Rng9 As Range
 
 GTri0 = Range("B" & VTri0):        mRow = Clls.Cells(1, 1).Row
 RowM = mRow + Clls.Rows.Count - 1
 Set Rng9 = Range("A" & (VTri0 + 1) & ":A" & RowM)
 For Each Rng In Rng9
    With Rng
        .Offset(, 6) = .Value + .Offset(-1, 6)
        .Offset(, 7) = GTri0 + .Offset(, 1)
    End With
 Next Rng
 For Zz = (VTri0 - 1) To mRow Step -1
    With Cells(Zz, 1)
        .Offset(, 6) = .Value + .Offset(1, 6)
        .Offset(, 7) = GTri0 + .Offset(, 1)
    End With
 Next Zz
End Sub

hongiayviet · 10-05-2008, 11:04 AM

Giờ mới nhìn kỷ lại bài này... Thấy dùng công thức bình thường cũng đơn giãn lắm mà... Quan trong nhất là định vị dc vị trí của số 0 trong bảng là xong!
Bạn xem file thử thế nào nhé!
ANH TUẤN

Chủ đề: Chuyển đổi dữ liệu

Công cụ Chủ đề

Tìm Chủ đề

Hiển thị

View more random threads:

Chuyển đổi dữ liệu

Quyền viết bài